pax_global_header 0000666 0000000 0000000 00000000064 13734156663 0014530 g ustar 00root root 0000000 0000000 52 comment=85143dcba286183541ed05f40d811316c6845ae8
arm_info-2020.1-src/ 0000775 0000000 0000000 00000000000 13734156663 0014173 5 ustar 00root root 0000000 0000000 arm_info-2020.1-src/NEWS 0000664 0000000 0000000 00000003063 13734156663 0014674 0 ustar 00root root 0000000 0000000 ada-ref-man NEWS -- history of user-visible changes.
Copyright (C) 2018 Free Software Foundation, Inc.
See the end of the file for license conditions.
* 2020.1
** Update to Ada 202x draft 25
http://www.ada-auth.org/standards/ada2x.html; some features
are supported in GNAT Community 2020 compiler.
** Generate an info index, containing entries from the ARM Index.
* 2012.5
3 Mar 2019
** Fix 'dir' file; it refered to arm2005, which is no longer in this
package.
* 2012.4
16 Sep 2018
** Mark italics with <>. Italics is used in names to convey semantic
information; the syntax name is the non-italized part (see LRM
1.1.5 14). In previous ada-ref-man releases, it was not possible to
distinguish the italicized part.
----------------------------------------------------------------------
This file is part of GNU Emacs.
GNU Emacs 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.
GNU Emacs 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 GNU Emacs. If not, see .
Local variables:
coding: utf-8
mode: outline
paragraph-separate: "[ ]*$"
end:
arm_info-2020.1-src/README.txt 0000664 0000000 0000000 00000010207 13734156663 0015671 0 ustar 00root root 0000000 0000000 Project to serve as a convenient packaging of the Ada Reference Manual
formatter and sources.
What is the Ada Reference Manual?
=================================
The Ada Reference Manual is the free (libre) version of the
international standard ISO/IEC 8652:2012(E). It describes a
programming language called "Ada".
The Ada Reference Manual was last revised in 2012, and approved by ISO
in 2013; it is called "Ada 2012". Previous versions are labeled Ada 95
and Ada 2005.
The official version of the Ada Reference Manual is available at
http://www.adaic.com/standards/ (draft of next version at
http://www.ada-auth.org/standards/ada2x.html). That site also provides
versions of the manual with change markup.
For each year version, there are two different versions of manual, one
that contains just the text of the official standard, and one which
contains additional annotations for compiler writers, language lawyers
etc. The latter version is called the "Annotated Ada Reference Manual"
(or AARM for short). Both versions are provided by this package.
Why aren't these files the same as upstream?
================================================
The text and HTML files are the same as upstream (processed by the
same tool from the same Scribe sources).
The upstream release does not include an info version; this package
uses the upstream tool to produce texinfo format from the upstream
Scribe sources, and then standard tools to produce info format.
The upstream PDF files are produced from the Scribe sources using
Microsoft word as an intermediate step. The PDF file built by this
package is produced from the texinfo intermediate; it is intended for
paper printing only, since it has no hyperlinks.
Why don't these PDF files have hyperlinks?
==========================================
The upstream PDF files don't have hyperlinks either. The problem is
the intermediate processors; they don't generate proper hyperlinks for
PDF (they do for HTML and info). To get hyperlinks in PDF, we would
need to adapt the Ada code to produce PDF directly from the original
source.
Where do these files come from?
===============================
The "upstream" for this distribution is a CVSWeb HTML interface at
http://www.ada-auth.org/cgi-bin/cvsweb.cgi/ARM/.
The file build/download.py provides simple tools to download the
upstream source; that is run from build/Makefile.
Usage
=====
There are two branches in the Gnu savannah server
(git.sv.gnu.org:/srv/git/ada-mode.git):
org.adaic.arm_form.upstream
Verbatim copy of the sources in the AdaIC CVS web server
http://www.ada-auth.org/cgi-bin/cvsweb.cgi/arm/
except that:
the file names are converted to lowercase.
the line endings in the source directory are converted to unix.
org.adaic.arm_form
Local branch with minor changes, the texinfo generator, and a
Makefile that builds everything.
To do a release:
NEWS
document changes
build/Makefile
if necessary, update AVAILABLE_YEARS for latest version
also all other occurances of 2012 in Makefile
a new year will have a new change version; update
progs.arm_texi.adb 'case Change_Version'
if no new version, bump trailing digit in ZIP_VERSION
otherwise, reset digit to 1
update_upstream
If download.py reports non-zero failed downloads, run it in a
shell repeatedly (for one year), until it reports no failed
downloads.
If download.py reports non-zero no such tag (should only
happen with draft versions), run 'download.py HEAD', after all
tagged files are succesfully downloaded.
Then make:
mark_%_downloaded
source_scribe_%.stamp
repeat for each year, and 'progs'.
(dvc-status "../org.adaic.arm_form.upstream")
commit message "update from upstream"
(dvc-propagate-one "../org.adaic.arm_form.upstream" ".")
build/Makefile
all publish
verify the following in progs/arm_texi.adb:
Z:: no entries for Z?
look near end of arm.texinfo
Update web page
/Projects/Web/stephe-leake/ada/arm.html
~/Web/Makefile
edit ARM_INFO_ZIP_VERSION
arm_info sync
(dvc-status ".")
arm_info-2020.1-src/build/ 0000775 0000000 0000000 00000000000 13734156663 0015272 5 ustar 00root root 0000000 0000000 arm_info-2020.1-src/build/Makefile 0000775 0000000 0000000 00000020361 13734156663 0016737 0 ustar 00root root 0000000 0000000 # Compilation of the Scribe formatter written for the Ada Reference
# Manual, translating .ms[ms] files into various formats. Also build
# tar.gz for the web page.
# Copyright (c) 2010, 2013 Stephen Leake
# Copyright (c) 2013 Nicolas Boulenguez
# 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; either version 3 of the License, or
# (at your option) any later version.
# 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, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
# Specific targets generate every $document$year.$format combination.
# Ex: make arm2012.pdf
AVAILABLE_DOCUMENTS := aarm arm
AVAILABLE_YEARS := 2005 2012 2020
AVAILABLE_FORMATS := html info texinfo txt pdf
# 'all' builds all versions except pdf; to build a subset, override these on the command line.
DOCUMENTS := $(AVAILABLE_DOCUMENTS)
YEARS := $(AVAILABLE_YEARS)
FORMATS := $(filter-out pdf texinfo, $(AVAILABLE_FORMATS))
# Texinfo is an intermediate, and is built as necessary.
# Pdf requires installation of many huge formatting tools; we assume they are not installed.
# see ../README.txt for list of things to change when Scribe or Ada source changes.
#
# Cygwin texi2dvi (GNU Texinfo 4.13) 1.135 fails silently!
# Debian standard build flags for Ada projects
BUILDER_OPTIONS := -k
ADAFLAGS :=
LDFLAGS :=
# arm_info.gpr sets its own flags, then appends these variables so
# that they take precedence. The intent is that you may configure the
# build with a simple variable override.
PYTHON ?= python3
EMACS_EXE ?= emacs
.PHONY: all clean publish
all: $(foreach d,$(DOCUMENTS),\
$(foreach y,$(YEARS),\
$(foreach f,$(FORMATS),\
$(d)$(y).$(f))))
create-dir : force
for file in *.info; do install-info $$file dir; done
# We have been unable to get rid of all the section ref violations, so we
# specify --no-validate. Delete that to see the errors.
TEXI_INFO_OPTS := --no-split --no-number-sections --no-validate
TEXI_PDF_OPTS := --quiet
SOURCE_DIR_2005 := ../source_2005
SOURCE_DIR_2012 := ../source_2012
SOURCE_DIR_2020 := ../source_2020
# See progs/command.txt.
CHANGES := New-Only
# See arm_form.ada comment before Get_Commands for possible values
VERSION_2005 := 2
VERSION_2012 := 4
VERSION_2020 := 5
# Mapping from document acronyms to Randy's file names
MASTER_arm := rm.msm
MASTER_aarm := aarm.msm
# Rough dependency, but Scribe files should not change often.
SOURCES_2005 := $(wildcard $(SOURCE_DIR_2005)/*.ms[ms])
SOURCES_2012 := $(wildcard $(SOURCE_DIR_2012)/*.ms[ms])
SOURCES_2020 := $(wildcard $(SOURCE_DIR_2020)/*.ms[ms])
define doc_year_build
# Non-unique intermediate paths would create a race condition, so we
# store the temporary result into the versioned source directory.
$(d)$(y).texinfo: arm_form.exe $(SOURCES_$(y))
cd $(SOURCE_DIR_$(y)); \
$(CURDIR)/$$< $(MASTER_$(d)) info $(CHANGES) $(VERSION_$(y)) $(VERSION_$(y)) ./; \
mv `sed -ne '/^@FilePrefix{\(.*\)}/{s//\L\1/p;q}' $(MASTER_$(d))`.texinfo $(CURDIR)/$$@
clean::
rm -f $(d)$(y).texinfo
$(d)$(y).html: arm_form.exe $(SOURCES_$(y))
rm -f -r $$@
mkdir --parents $$@
cd $(SOURCE_DIR_$(y)); \
$(CURDIR)/$$< $(MASTER_$(d)) HTML $(CHANGES) $(VERSION_$(y)) $(VERSION_$(y)) $(CURDIR)/$$@/
clean::
rm -f -r $(d)$(y).html
$(d)$(y).txt: arm_form.exe $(SOURCES_$(y))
rm -f -r $$@
mkdir --parents $$@
cd $(SOURCE_DIR_$(y)); \
$(CURDIR)/$$< $(MASTER_$(d)) Text $(CHANGES) $(VERSION_$(y)) $(VERSION_$(y)) $(CURDIR)/$$@/
for i in $$@/*; do \
iconv --from-code=iso8859-1 --to-code=utf-8 > $$@/tmp $$$$i && mv $$@/tmp $$$$i; \
done
clean::
rm -f -r $(d)$(y).txt
# ../progs/arm-texi-index.el adds texinfo index entries.
$(d)$(y).texinfo-index: $(d)$(y).texinfo
$(EMACS_EXE) -Q -batch -L ../progs -l arm-texi-index.el --eval '(progn(do-index "$$<")(kill-emacs))'
touch $$@
clean::
rm -f $(d)$(y).texinfo-index
# texi2any is from texinfo 5
$(d)$(y).info: $(d)$(y).texinfo-index
texi2any --info $(TEXI_INFO_OPTS) $(d)$(y).texinfo -o $$@
clean::
rm -f $(d)$(y).info
$(d)$(y).pdf: $(d)$(y).texinfo
texi2any --pdf $(TEXI_PDF_OPTS) $$< -o $$@
clean::
rm -f $(d)$(y).aux $(d)$(y).cp $(d)$(y).cps $(d)$(y).log $(d)$(y).pdf $(d)$(y).toc
endef
$(foreach d,$(AVAILABLE_DOCUMENTS),\
$(foreach y,$(AVAILABLE_YEARS),\
$(eval $(doc_year_build))))
arm_form.exe : force
gnatmake -p $(BUILDER_OPTIONS) -P arm_info.gpr $(foreach var,ADAFLAGS LDFLAGS,"-X$(var)=$($(var))")
clean::
rm -f arm_form.exe
rm -f -r objects __pycache__
trace :
addr2line -e arm_form.exe 0x52f218 0x54d4de 0x402123 0x405c6e 0x401393 0x4014f9 0x7ffd98271410 0x7ffd990454f2
# year is latest standard; bump trailing digit for any change.
ZIP_VERSION := $(lastword $(AVAILABLE_YEARS)).1
INFO_ARCHIVE := arm_info-$(ZIP_VERSION).tar.gz
SOURCE_ARCHIVE := arm_info-$(ZIP_VERSION)-src.tar.gz
publish: $(INFO_ARCHIVE) $(SOURCE_ARCHIVE)
# --no-name eliminates time stamps, which helps make the tarball reproducible
# --best gives higher compression than the default; we can afford the time here.
GZIP := --no-name --best
$(INFO_ARCHIVE): $(foreach d,$(DOCUMENTS),\
$(foreach y,$(YEARS),\
$(d)$(y).info))
tar cf - $^ | gzip $(GZIP) -c > $@
clean::
rm -f $(INFO_ARCHIVE)
$(SOURCE_ARCHIVE): force
(cd .. && git archive --prefix=arm_info-$(ZIP_VERSION)-src/ org.adaic.arm_form *) | gzip $(GZIP) -c > $@
clean::
rm -f $(SOURCE_ARCHIVE)
update_upstream : source_ada.clean source_ada.stamp
update_upstream : source_scribe_2005.clean source_scribe_2005.stamp
update_upstream : source_scribe_2012.clean source_scribe_2012.stamp
update_upstream : source_scribe_2020.clean source_scribe_2020.stamp
# download.py does not convert to unix line endings here to minimize
# the diff with upstream; the Ada compiler can handle DOS line endings
# on Unix. download.py does convert file names to lower case here, for
# consistency.
source_ada.stamp :
rm -rf ../../org.adaic.arm_form.upstream/progs
cd ../../org.adaic.arm_form.upstream; $(PYTHON) ../org.adaic.arm_form/build/download.py progs
touch source_ada.stamp
source_ada.clean :
rm -f source_ada.stamp
# This retrieves the CVS tag for the year given on the command line
# commit to mtn: (dvc-status "../../org.adaic.arm_form.upstream")
#
# download.py converts to unix line endings here, because the scribe
# processor insists on uniform formatting; this works for both Windows
# and Debian. download.py also converts all file names to lowercase,
# and arm_form does as well; upstream only runs on Windows, which
# ignores case in filenames, so the file names in the sources are not
# consistently cased.
source_scribe_%_downloaded.stamp :
rm -rf ../../org.adaic.arm_form.upstream/source_$*
cd ../../org.adaic.arm_form.upstream; $(PYTHON) ../org.adaic.arm_form/build/download.py $*
# download.py often times out, so we need to run it multiple times,
# then manually mark it done. Then make source_scribe_%.stamp
mark_%_downloaded :
touch source_scribe_$*_downloaded.stamp
source_scribe_%.stamp : source_scribe_%_downloaded.stamp
mv ../../org.adaic.arm_form.upstream/source ../../org.adaic.arm_form.upstream/source_$*
touch source_scribe_$*.stamp
source_scribe_%.clean :
rm -f source_scribe_$*.stamp
# These sources do not match the corresponding CVS tag, although they are close.
ARM_SRC.ZIP ARM_FORM.ZIP ARM_FSRC.ZIP 2005-SRC.zip 2012-SRC.zip :
wget http://www.ada-auth.org/arm-files/$@
# delete everything back to mtn checkout
#
# Note that additional 'clean' targets are specified after every
# target that builds something.
clean ::
rm -f *.stamp *.zip
info-clean :
rm -f *.info*
.PHONY : force
VPATH = ../source_2005 ../source_2012 ../source_2020 ../progs
#Local Variables:
#eval: (delete '("\\.mss\\'" . scribe-mode) auto-mode-alist)
#eval: (ada-parse-prj-file "arm_info.prj")
#eval: (ada-select-prj-file "arm_info.prj")
#End:
# end of file
arm_info-2020.1-src/build/arm_info.gpr 0000664 0000000 0000000 00000006041 13734156663 0017577 0 ustar 00root root 0000000 0000000 project ARM_Info is
for Source_Dirs use
("../progs");
for Main use ("arm_form.ada");
for Object_Dir use "objects";
for Exec_Dir use ".";
package Naming is
for Spec ("ARM_Contents") use "arm_cont.ads";
for Body ("ARM_Contents") use "arm_cont.adb";
for Spec ("ARM_Corr") use "arm_corr.ads";
for Body ("ARM_Corr") use "arm_corr.adb";
for Spec ("ARM_Database") use "arm_db.ads";
for Body ("ARM_Database") use "arm_db.adb";
for Spec ("ARM_File") use "arm_file.ads";
for Body ("ARM_File") use "arm_file.adb";
for Spec ("ARM_Format") use "arm_frm.ads";
for Body ("ARM_Format") use "arm_frm.adb";
for Spec ("ARM_Format.Data") use "arm_frmd.ads";
for Body ("ARM_Format.Data") use "arm_frmd.adb";
for Body ("ARM_Format.Scan") use "arm_frms.adb";
for body ("ARM_Formatter") use "arm_form.ada";
for spec ("ARM_HTML") use "arm_html.ads";
for Body ("ARM_HTML") use "arm_html.adb";
for Spec ("ARM_Index") use "arm_indx.ads";
for Body ("ARM_Index") use "arm_indx.adb";
for Spec ("ARM_Input") use "arm_inp.ads";
for Body ("ARM_Input") use "arm_inp.adb";
for Spec ("ARM_Master") use "arm_mast.ads";
for Body ("ARM_Master") use "arm_mast.adb";
for Spec ("ARM_Output") use "arm_out.ads";
for spec ("ARM_RTF") use "arm_rtf.ads";
for Body ("ARM_RTF") use "arm_rtf.adb";
for Spec ("ARM_String") use "arm_str.ads";
for Body ("ARM_String") use "arm_str.adb";
for Spec ("ARM_Subindex") use "arm_sub.ads";
for Body ("ARM_Subindex") use "arm_sub.adb";
for Spec ("ARM_Syntax") use "arm_syn.ads";
for Body ("ARM_Syntax") use "arm_syn.adb";
for Spec ("ARM_Text") use "arm_text.ads";
for Body ("ARM_Text") use "arm_text.adb";
for Spec ("ARM_Texinfo") use "arm_texi.ads";
for Body ("ARM_Texinfo") use "arm_texi.adb";
end Naming;
package Compiler is
-- upstream wants Ada 2005 syntax, no GNAT-specific pragmas.
-- We disable some warnings to minimize source diff with upstream.
-- We append ADAFLAGS so the Makefile can add or override options.
Switches :=
("-g",
"-O0",
"-gnatfoqQ",
"-gnatVa",
"-gnatwaCeFKLMP",
"-fstack-check",
"-gnatybefp")
& External_As_List ("ADAFLAGS", " ");
for Default_Switches ("Ada") use Switches;
-- arm_frm has code that passes the same object via two 'in out'
-- params; GNAT 4.8 warns about that, so we suppress the warning
-- here.
for Switches ("arm_frm.adb") use Switches & ("-gnatw.I");
end Compiler;
package Binder is
for Default_Switches ("Ada") use ("-E");
end Binder;
package Builder is
for Default_Switches ("Ada") use ("-C");
-- We use ".exe" extension even on non-Windows, to simplify the makefiles.
for Executable_Suffix use ".exe";
for Executable ("ARM_FORM.ADA") use "arm_form.exe";
end Builder;
package Linker is
for Default_Switches ("Ada") use External_As_List ("LDFLAGS", " ");
end Linker;
end ARM_Info;
arm_info-2020.1-src/build/arm_info.prj 0000664 0000000 0000000 00000000064 13734156663 0017601 0 ustar 00root root 0000000 0000000 gpr_file=arm_info.gpr
casing=emacs_case_exceptions
arm_info-2020.1-src/build/download.py 0000775 0000000 0000000 00000014052 13734156663 0017460 0 ustar 00root root 0000000 0000000 #!/usr/bin/python3
# Script to download the Ada Reference Manual and its formatting tool.
# Copyright (c) 2010, 2012 Stephen Leake
# Copyright (c) 2013 Nicolas Boulenguez
# 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; either version 3 of the License, or
# (at your option) any later version.
# 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, write to the Free Software
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
import os.path
import re
import urllib.request
import sys
USE_EXISTING_FILES = True
######################################################################
class CVSWeb ():
def __init__ (self, hostname, top_directory):
# Instantiation requires distant root.
self._host = 'http://' + hostname
self._cgi = '/cgi-bin/cvsweb.cgi/' + top_directory + '/'
def files_in_directory (self, path):
# List text files in the head revision of a directory.
# I did not find a way to list a tagged revision, except a
# direct tag list for each file.
cgi = self._cgi + str.lower (path) + '/'
with urllib.request.urlopen (self._host + cgi) as f:
contents = f.read ()
# Refuse directory names (with a trailing slash).
# Ignore case of the displayed file name.
pattern = '(\\1)
'
matches = re.finditer (str.encode (pattern), contents, re.IGNORECASE)
return (bytes.decode (m.group (2)) for m in matches)
def download_file (self, path,
tag = None): # None means the head revision.
# Return the contents of the tagged revision of path, as bytes.
# If tag is provided, but no revision of this file carries it,
# None is returned.
cgi = self._cgi + str.lower (path)
if tag != None:
with urllib.request.urlopen (self._host + cgi) as f:
contents = f.read ()
pattern = '\\1
\r\n' \
+ 'Modified [^<]*\r\n' \
+ 'by [^<]*( with line changes [^<]*)?
\r\n' \
+ 'CVS Tags: [^<]*' + re.escape (tag) + '[^<]*
'
match = re.search (str.encode (pattern), contents)
if not match:
return None
rev = bytes.decode (match.group (1))
cgi += '?rev=' + rev
print ('{:<30} : {}'.format (path, rev))
else:
cgi += '?rev=HEAD'
with urllib.request.urlopen (self._host + cgi) as f:
contents = f.read ()
return contents
######################################################################
def download_subdir (cvsweb, subdir,
tag = None, # None means the head revision.
rename_lowercase = False,
strip_carriage_returns = False):
def fmt (a, b):
print ('{:<30} : {}'.format (a, b))
fmt ('Subdirectory', subdir)
if tag:
fmt ('Revision', tag)
else:
fmt ('Revision', 'latest')
fmt ('Renaming files to lowercase', rename_lowercase)
fmt ('Stripping carriage returns', strip_carriage_returns)
try:
os.mkdir (subdir) # Fails if the directory exists.
except FileExistsError:
if not USE_EXISTING_FILES:
raise
failed_count = 0
no_such_tag_count = 0
for basename in cvsweb.files_in_directory (subdir):
src = subdir + '/' + basename
if rename_lowercase:
basename = str.lower (basename)
dst = os.path.join (subdir, basename) # Local path join.
if USE_EXISTING_FILES and os.path.exists (dst):
fmt (dst, 'using existing file')
continue
try:
contents = cvsweb.download_file (src, tag)
if not contents:
fmt (dst, 'no such tag')
no_such_tag_count = no_such_tag_count + 1
continue
if strip_carriage_returns:
contents = re.sub (b'\r\n', b'\n', contents)
with open (dst, 'bw') as o:
o.write (contents)
fmt (dst, 'downloaded')
except urllib.error.URLError:
fmt (dst, 'download failed')
failed_count = failed_count + 1
fmt ('no such tag :', no_such_tag_count)
fmt ('failed downloads:', failed_count)
######################################################################
cvsweb = CVSWeb (hostname = 'www.ada-auth.org',
top_directory = 'arm')
tags = { '1995':'Final_TC1',
'2005':'Amend_Final',
'2012':'Ada2012_TC1',
'2020':'Ada202x_D25' }
if len (sys.argv) == 2 and sys.argv [1] == 'progs':
download_subdir (cvsweb, 'progs',
rename_lowercase = True)
print ("""
No certification or signature used for downloaded code sources.
Hint: diff -rN --ignore-file-name-case --strip-trailing-cr old/ progs/
""")
elif len (sys.argv) == 2 and sys.argv [1] in tags:
download_subdir (cvsweb, 'source',
tag = tags [sys.argv [1]],
rename_lowercase = True,
strip_carriage_returns = True)
elif len (sys.argv) == 2 and sys.argv [1] == 'HEAD':
download_subdir (cvsweb, 'source',
tag = 'HEAD',
rename_lowercase = True,
strip_carriage_returns = True)
else:
print ('Usage: {} [progs | {}]'.format (
sys.argv [0],
str.join (' | ', sorted ([str (year) for year in tags.keys ()]))))
arm_info-2020.1-src/build/emacs_case_exceptions 0000664 0000000 0000000 00000000014 13734156663 0021534 0 ustar 00root root 0000000 0000000 *ARM
*LaTeX
arm_info-2020.1-src/progs/ 0000775 0000000 0000000 00000000000 13734156663 0015325 5 ustar 00root root 0000000 0000000 arm_info-2020.1-src/progs/alkc.bat 0000664 0000000 0000000 00000000347 13734156663 0016733 0 ustar 00root root 0000000 0000000 Move .\Object\%1.Obj .
link -subsystem:console -entry:mainCRTStartup -out:%1.exe %1.obj libc.lib kernel32.lib -map:%1.map
Del %1.Obj
Rem Del %1.Map
Copy %1.Exe \RRS\Docs
Move %1.Exe ..\Source
Move .\Object\%1.Dbg ..\Source
arm_info-2020.1-src/progs/arm-texi-index.el 0000664 0000000 0000000 00000004624 13734156663 0020510 0 ustar 00root root 0000000 0000000 ;;; Insert texinfo index entries into arm*.texinfo -*- lexical-binding:t -*-
;; Copyright (C) 2020 Free Software Foundation, Inc.
;;
;; Author: Stephen Leake
;; Maintainer: Stephen Leake
;; This file is part of GNU Emacs.
;;
;; GNU Emacs 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.
;;
;; GNU Emacs 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 GNU Emacs. If not, see .
(defun insert-index-entries ()
"Read the index @chapter, insert @cindex entries in sections."
;; The texinfo file is produced by the arm_form executable; see
;; arm_texi.adb for some info.
(goto-char (point-min))
;; First add the menu entry
(search-forward "@menu")
(search-forward "@end menu")
(goto-char (line-beginning-position))
(insert "* Concept Index :: Concept Index\n")
;; now the command to build the index and print it
(goto-char (point-max))
(goto-char (line-beginning-position 0))
(insert "@node Concept Index\n")
(insert "@unnumbered Concept Index\n")
(insert "@printindex cp\n")
;; Now insert all the @cindex items
(search-backward "@chapter Index")
(let (next-search-pos)
(while (search-forward-regexp "@ref{ \\([0-9]+\\), \\([0-9.(/)]+\\)}" nil t)
(setq next-search-pos (copy-marker (point))) ;; we are inserting text before this point!
;; There can be more than one @ref on a line; they are all for the
;; same entry; texinfo can handle that.
(let ((ref (match-string-no-properties 1))
text)
(goto-char (line-beginning-position))
(when (looking-at "\\(?:@w{ }\\)*\\(.*?\\)@w{ }")
(setq text (match-string-no-properties 1))
(goto-char (point-min))
(search-forward (concat "@anchor{ " ref "}"))
(insert (concat "\n@cindex " text "\n")))
(goto-char next-search-pos)))))
(defun do-index (filename)
(find-file filename)
(insert-index-entries)
(save-buffer))
(provide 'arm-texi-index)
;;; ada-mode.el ends here
arm_info-2020.1-src/progs/arm_cont.adb 0000664 0000000 0000000 00000072200 13734156663 0017600 0 ustar 00root root 0000000 0000000 with Ada.Characters.Handling;
--with Ada.Text_IO; -- Debug.
--with Ada.Exceptions;
package body ARM_Contents is
--
-- Ada reference manual formatter (ARM_Form).
--
-- This package contains the routines to manage section/clause/subclause
-- references.
--
-- ---------------------------------------
-- Copyright 2000, 2004, 2005, 2006, 2007, 2008, 2009, 2011, 2012
-- AXE Consultants. All rights reserved.
-- P.O. Box 1512, Madison WI 53701
-- E-Mail: randy@rrsoftware.com
--
-- ARM_Form is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License version 3
-- as published by the Free Software Foundation.
--
-- AXE CONSULTANTS MAKES THIS TOOL AND SOURCE CODE AVAILABLE ON AN "AS IS"
-- BASIS AND MAKES NO WARRANTY, EXPRESS OR IMPLIED, AS TO THE ACCURACY,
-- CAPABILITY, EFFICIENCY, MERCHANTABILITY, OR FUNCTIONING OF THIS TOOL.
-- IN NO EVENT WILL AXE CONSULTANTS BE LIABLE FOR ANY GENERAL,
-- CONSEQUENTIAL, INDIRECT, INCIDENTAL, EXEMPLARY, OR SPECIAL DAMAGES,
-- EVEN IF AXE CONSULTANTS HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-- DAMAGES.
--
-- A copy of the GNU General Public License is available in the file
-- gpl-3-0.txt in the standard distribution of the ARM_Form tool.
-- Otherwise, see .
--
-- If the GPLv3 license is not satisfactory for your needs, a commercial
-- use license is available for this tool. Contact Randy at AXE Consultants
-- for more information.
--
-- ---------------------------------------
--
-- Edit History:
--
-- 4/19/00 - RLB - Created base package.
-- 4/26/00 - RLB - Added Previous_Clause and Next_Clause.
-- 5/15/00 - RLB - Added rules about unnumbered sections.
-- 5/22/00 - RLB - Added Unnumbered_Section level.
-- 8/22/00 - RLB - Added Old_Title handling.
-- 9/ 9/04 - RLB - Removed unused with.
-- 2/ 2/05 - RLB - Allowed more old titles.
-- 1/16/06 - RLB - Added debugging.
-- 9/22/06 - RLB - Created type Clause_Number_Type and added SubSubClause.
-- 10/12/07 - RLB - Extended the range of properly formatted clause numbers.
-- 12/18/07 - RLB - Added Plain_Annex.
-- 10/24/08 - RLB - More old titles.
-- 5/07/09 - RLB - Added Dead_Clause.
-- 10/18/11 - RLB - Changed to GPLv3 license.
-- 10/19/11 - RLB - Added Parent_Clause from Stephen Leake's version.
-- 10/25/11 - RLB - Added version to Old name strings.
-- 8/30/12 - RLB - Added traps if we're reading Section = UNKNOWN.
function "<" (Left, Right : Clause_Number_Type) return Boolean is
-- True if Left comes before Right in the collating order.
begin
if Left.Section = UNKNOWN then
raise Bad_Clause_Error with "Left has Unknown section";
elsif Right.Section = UNKNOWN then
raise Bad_Clause_Error with "Right has Unknown section";
elsif Left.Section < Right.Section then
return True;
elsif Left.Section > Right.Section then
return False;
elsif Left.Clause < Right.Clause then
return True;
elsif Left.Clause > Right.Clause then
return False;
elsif Left.Subclause < Right.Subclause then
return True;
elsif Left.Subclause > Right.Subclause then
return False;
elsif Left.Subsubclause < Right.Subsubclause then
return True;
else
return False;
end if;
end "<";
function ">" (Left, Right : Clause_Number_Type) return Boolean is
-- True if Left comes after Right in the collating order.
begin
return Right < Left;
end ">";
function "<=" (Left, Right : Clause_Number_Type) return Boolean is
-- True if Left comes before or is the same as Right in the
-- collating order.
begin
return not (Right < Left);
end "<=";
function ">=" (Left, Right : Clause_Number_Type) return Boolean is
-- True if Left comes after or is the same as Right in the
-- collating order.
begin
return not (Left < Right);
end ">=";
type Title_Record is record
Title : Title_Type; -- Title in original format.
Search_Title : Title_Type; -- Title in all lower case.
Level : Level_Type;
Clause_Number : Clause_Number_Type;
Version : ARM_Contents.Change_Version_Type := '0';
end record;
Title_List : array (1 .. 900) of Title_Record;
Last_Title : Natural;
Old_Title_List : array (1 .. 300) of Title_Record;
Last_Old_Title : Natural;
procedure Initialize is
-- Initialize this package; make sure the contents are empty.
begin
Last_Title := 0;
end Initialize;
procedure Add (Title : in Title_Type;
Level : in Level_Type;
Clause_Number : in Clause_Number_Type;
Version : in ARM_Contents.Change_Version_Type := '0') is
-- Add a section or clause to the contents. It has the specified
-- characteristics.
begin
if Level /= Subsubclause and then Clause_Number.Subsubclause /= 0 then
raise Bad_Clause_Error with "not a subsubclause but non-zero subsubclause number";
end if;
if Level /= Subsubclause and then
Level /= Subclause and then Clause_Number.Subclause /= 0 then
raise Bad_Clause_Error with "not a subclause but non-zero subclause number";
end if;
if (Level /= Subsubclause and then Level /= Subclause and then
Level /= Clause and then Level /= Unnumbered_Section and then
Level /= Dead_Clause) and then
Clause_Number.Clause /= 0 then
raise Bad_Clause_Error with "not a clause but non-zero clause number";
end if;
Last_Title := Last_Title + 1;
Title_List (Last_Title) :=
(Title => Title,
Search_Title => Ada.Characters.Handling.To_Lower (Title),
Level => Level,
Clause_Number => Clause_Number,
Version => Version);
--Ada.Text_IO.Put_Line (" Add " & Title &
-- " Index=" & Natural'Image(Last_Title) & " Level=" & Level_Type'Image(Level));
--Ada.Text_IO.Put_Line (" Section" & Section_Number_Type'Image(Clause_Number.Section) &
-- " Clause" & Natural'Image(Clause_Number.Clause) & " Subclause" & Natural'Image(Clause_Number.Subclause) &
-- " Subsubclause" & Natural'Image(Clause_Number.Subsubclause));
end Add;
procedure Add_Old (Old_Title : in Title_Type;
Level : in Level_Type;
Clause_Number : in Clause_Number_Type;
Version : in ARM_Contents.Change_Version_Type := '0') is
-- Add an old title for a section or clause to the contents. It has
-- the specified characteristics; the version is the version for which
-- it first was present in the document.
begin
if Level /= Subsubclause and then Clause_Number.Subsubclause /= 0 then
raise Bad_Clause_Error with "not a subsubclause but non-zero subsubclause number";
end if;
if Level /= Subsubclause and then
Level /= Subclause and then Clause_Number.Subclause /= 0 then
raise Bad_Clause_Error with "not a subclause but non-zero subclause number";
end if;
if (Level /= Subsubclause and then Level /= Subclause and then
Level /= Clause and then Level /= Unnumbered_Section and then
Level /= Dead_Clause) and then
Clause_Number.Clause /= 0 then
raise Bad_Clause_Error with "not a clause but non-zero clause number";
end if;
Last_Old_Title := Last_Old_Title + 1;
Old_Title_List (Last_Old_Title) :=
(Title => Old_Title,
Search_Title => Ada.Characters.Handling.To_Lower (Old_Title),
Level => Level,
Clause_Number => Clause_Number,
Version => Version);
--Ada.Text_IO.Put_Line (" Add_Old " & Old_Title &
-- " Index=" & Natural'Image(Last_Old_Title) & " Level=" & Level_Type'Image(Level));
--Ada.Text_IO.Put_Line (" Section" & Section_Number_Type'Image(Section_Number) &
-- " Clause" & Natural'Image(Clause_Number.Clause) & " Subclause" & Natural'Image(Clause_Number.Subclause) &
-- " Subsubclause" & Natural'Image(Clause_Number.Subsubclause));
end Add_Old;
function Make_Clause_Number (Level : in Level_Type;
Clause_Number : in Clause_Number_Type) return String is
-- Returns a properly formatted Section or clause number reference.
begin
if Clause_Number.Section = UNKNOWN then
raise Bad_Clause_Error with "unknown section number";
-- else not unknown
end if;
case Level is
when Plain_Annex | Normative_Annex | Informative_Annex =>
if Clause_Number.Clause /= 0 or else Clause_Number.Subclause /= 0 or else
Clause_Number.Subsubclause /= 0 or else Clause_Number.Section <= 30 then
raise Bad_Clause_Error; -- Illegal numbers.
end if;
return "Annex " & Character'Val (Character'Pos('A') + (Clause_Number.Section - ANNEX_START));
when Section =>
if Clause_Number.Clause /= 0 or else Clause_Number.Subclause /= 0 or else
Clause_Number.Section >= ANNEX_START then
raise Bad_Clause_Error; -- Illegal numbers.
end if;
if Clause_Number.Section < 10 then
return Character'Val (Character'Pos('0') + Clause_Number.Section) & "";
elsif Clause_Number.Section < 20 then
return "1" & Character'Val (Character'Pos('0') + Clause_Number.Section - 10);
elsif Clause_Number.Section < 30 then
return "2" & Character'Val (Character'Pos('0') + Clause_Number.Section - 20);
else
return "3" & Character'Val (Character'Pos('0') + Clause_Number.Section - 30);
end if;
when Unnumbered_Section =>
if Clause_Number.Clause = 0 or else Clause_Number.Subclause /= 0 or else
Clause_Number.Section /= 0 then
raise Bad_Clause_Error; -- Illegal numbers.
end if;
if Clause_Number.Clause < 10 then
return "0." & Character'Val (Character'Pos('0') + Clause_Number.Clause);
elsif Clause_Number.Clause < 20 then
return "0.1" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 10);
elsif Clause_Number.Clause < 30 then
return "0.2" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 20);
else
return "0.3" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 30);
end if;
when Clause =>
if Clause_Number.Subclause /= 0 then
raise Bad_Clause_Error; -- Illegal number.
end if;
if Clause_Number.Section < 10 then
if Clause_Number.Clause < 10 then
return Character'Val (Character'Pos('0') + Clause_Number.Section) &
"." & Character'Val (Character'Pos('0') + Clause_Number.Clause);
elsif Clause_Number.Clause < 20 then
return Character'Val (Character'Pos('0') + Clause_Number.Section) &
".1" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 10);
elsif Clause_Number.Clause < 30 then
return Character'Val (Character'Pos('0') + Clause_Number.Section) &
".2" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 20);
elsif Clause_Number.Clause < 40 then
return Character'Val (Character'Pos('0') + Clause_Number.Section) &
".3" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 30);
elsif Clause_Number.Clause < 50 then
return Character'Val (Character'Pos('0') + Clause_Number.Section) &
".4" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 40);
elsif Clause_Number.Clause < 60 then
return Character'Val (Character'Pos('0') + Clause_Number.Section) &
".5" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 50);
else
raise Bad_Clause_Error; -- Out of range.
end if;
elsif Clause_Number.Section < 20 then
if Clause_Number.Clause < 10 then
return "1" & Character'Val (Character'Pos('0') + Clause_Number.Section - 10) &
"." & Character'Val (Character'Pos('0') + Clause_Number.Clause);
elsif Clause_Number.Clause < 20 then
return "1" & Character'Val (Character'Pos('0') + Clause_Number.Section - 10) &
".1" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 10);
elsif Clause_Number.Clause < 30 then
return "1" & Character'Val (Character'Pos('0') + Clause_Number.Section - 10) &
".2" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 20);
elsif Clause_Number.Clause < 40 then
return "1" & Character'Val (Character'Pos('0') + Clause_Number.Section - 10) &
".3" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 30);
elsif Clause_Number.Clause < 50 then
return "1" & Character'Val (Character'Pos('0') + Clause_Number.Section - 10) &
".4" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 40);
elsif Clause_Number.Clause < 60 then
return "1" & Character'Val (Character'Pos('0') + Clause_Number.Section - 10) &
".5" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 50);
else
raise Bad_Clause_Error; -- Out of range.
end if;
elsif Clause_Number.Section < 30 then
if Clause_Number.Clause < 10 then
return "2" & Character'Val (Character'Pos('0') + Clause_Number.Section - 20) &
"." & Character'Val (Character'Pos('0') + Clause_Number.Clause);
elsif Clause_Number.Clause < 20 then
return "2" & Character'Val (Character'Pos('0') + Clause_Number.Section - 20) &
".1" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 10);
elsif Clause_Number.Clause < 30 then
return "2" & Character'Val (Character'Pos('0') + Clause_Number.Section - 20) &
".2" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 20);
elsif Clause_Number.Clause < 40 then
return "2" & Character'Val (Character'Pos('0') + Clause_Number.Section - 20) &
".3" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 30);
elsif Clause_Number.Clause < 50 then
return "2" & Character'Val (Character'Pos('0') + Clause_Number.Section - 20) &
".4" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 40);
elsif Clause_Number.Clause < 60 then
return "2" & Character'Val (Character'Pos('0') + Clause_Number.Section - 20) &
".5" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 50);
else
raise Bad_Clause_Error; -- Out of range.
end if;
elsif Clause_Number.Section = 30 then
if Clause_Number.Clause < 10 then
return "30." & Character'Val (Character'Pos('0') + Clause_Number.Clause);
elsif Clause_Number.Clause < 20 then
return "30.1" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 10);
elsif Clause_Number.Clause < 30 then
return "30.2" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 20);
elsif Clause_Number.Clause < 40 then
return "30.3" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 30);
elsif Clause_Number.Clause < 50 then
return "30.4" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 40);
elsif Clause_Number.Clause < 60 then
return "30.5" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 50);
else
raise Bad_Clause_Error; -- Out of range.
end if;
else
if Clause_Number.Clause < 10 then
return Character'Val (Character'Pos('A') + (Clause_Number.Section - ANNEX_START)) &
"." & Character'Val (Character'Pos('0') + Clause_Number.Clause);
elsif Clause_Number.Clause < 20 then
return Character'Val (Character'Pos('A') + (Clause_Number.Section - ANNEX_START)) &
".1" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 10);
elsif Clause_Number.Clause < 30 then
return Character'Val (Character'Pos('A') + (Clause_Number.Section - ANNEX_START)) &
".2" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 20);
elsif Clause_Number.Clause < 40 then
return Character'Val (Character'Pos('A') + (Clause_Number.Section - ANNEX_START)) &
".3" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 30);
elsif Clause_Number.Clause < 50 then
return Character'Val (Character'Pos('A') + (Clause_Number.Section - ANNEX_START)) &
".4" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 40);
elsif Clause_Number.Clause < 60 then
return Character'Val (Character'Pos('A') + (Clause_Number.Section - ANNEX_START)) &
".4" & Character'Val (Character'Pos('0') + Clause_Number.Clause - 50);
else
raise Bad_Clause_Error; -- Out of range.
end if;
end if;
when Subclause =>
if Clause_Number.Section = UNKNOWN then
raise Bad_Clause_Error with "unknown section number";
elsif Clause_Number.Subclause < 10 then
return Make_Clause_Number (Clause, (Clause_Number.Section, Clause_Number.Clause, 0, 0)) &
"." & Character'Val (Character'Pos('0') + Clause_Number.Subclause);
elsif Clause_Number.Subclause < 20 then
return Make_Clause_Number (Clause, (Clause_Number.Section, Clause_Number.Clause, 0, 0)) &
".1" & Character'Val (Character'Pos('0') + Clause_Number.Subclause - 10);
elsif Clause_Number.Subclause < 30 then
return Make_Clause_Number (Clause, (Clause_Number.Section, Clause_Number.Clause, 0, 0)) &
".2" & Character'Val (Character'Pos('0') + Clause_Number.Subclause - 20);
elsif Clause_Number.Subclause < 40 then
return Make_Clause_Number (Clause, (Clause_Number.Section, Clause_Number.Clause, 0, 0)) &
".3" & Character'Val (Character'Pos('0') + Clause_Number.Subclause - 30);
elsif Clause_Number.Subclause < 50 then
return Make_Clause_Number (Clause, (Clause_Number.Section, Clause_Number.Clause, 0, 0)) &
".4" & Character'Val (Character'Pos('0') + Clause_Number.Subclause - 40);
else
raise Bad_Clause_Error; -- Out of range.
end if;
when Subsubclause =>
if Clause_Number.Subsubclause < 10 then
return Make_Clause_Number (Subclause, (Clause_Number.Section, Clause_Number.Clause, Clause_Number.Subclause, 0)) &
"." & Character'Val (Character'Pos('0') + Clause_Number.Subsubclause);
elsif Clause_Number.Subclause < 20 then
return Make_Clause_Number (Subclause, (Clause_Number.Section, Clause_Number.Clause, Clause_Number.Subclause, 0)) &
".1" & Character'Val (Character'Pos('0') + Clause_Number.Subsubclause - 10);
elsif Clause_Number.Subclause < 30 then
return Make_Clause_Number (Subclause, (Clause_Number.Section, Clause_Number.Clause, Clause_Number.Subclause, 0)) &
".2" & Character'Val (Character'Pos('0') + Clause_Number.Subsubclause - 20);
elsif Clause_Number.Subclause < 40 then
return Make_Clause_Number (Subclause, (Clause_Number.Section, Clause_Number.Clause, Clause_Number.Subclause, 0)) &
".3" & Character'Val (Character'Pos('0') + Clause_Number.Subsubclause - 30);
elsif Clause_Number.Subclause < 50 then
return Make_Clause_Number (Subclause, (Clause_Number.Section, Clause_Number.Clause, Clause_Number.Subclause, 0)) &
".4" & Character'Val (Character'Pos('0') + Clause_Number.Subsubclause - 40);
else
raise Bad_Clause_Error; -- Out of range.
end if;
when Dead_Clause =>
return "X.X";
end case;
end Make_Clause_Number;
procedure Make_Clause (Clause_String : in String;
Clause_Number : out Clause_Number_Type) is
-- Returns the clause number for a properly formatted Section or
-- clause string.
Next : Positive;
function Get_Section_Number return Section_Number_Type is
-- Extract the section number:
begin
if Clause_String'Length = 1 or else
Clause_String(Clause_String'First + 1) = '.' then
Next := Clause_String'First + 2;
if Clause_String (Clause_String'First) in '0' .. '9' then
return Character'Pos(Clause_String (Clause_String'First)) - Character'Pos('0');
else
return Character'Pos(Clause_String (Clause_String'First)) - Character'Pos('A') + ANNEX_START;
end if;
else
Next := Clause_String'First + 3;
return (Character'Pos(Clause_String (Clause_String'First)) - Character'Pos('0')) * 10 +
Character'Pos(Clause_String (Clause_String'First + 1)) - Character'Pos('0');
end if;
end Get_Section_Number;
function Get_Clause_Number return Natural is
-- Extract the clause:
begin
if Clause_String'Last - Next + 1 = 1 or else
Clause_String(Next + 1) = '.' then
Next := Next + 2;
return Character'Pos(Clause_String (Next - 2)) - Character'Pos('0');
else
Next := Next + 3;
return (Character'Pos(Clause_String (Next - 3)) - Character'Pos('0')) * 10 +
Character'Pos(Clause_String (Next - 3 + 1)) - Character'Pos('0');
end if;
end Get_Clause_Number;
begin
if Clause_String'Length = 7 and then
Clause_String (Clause_String'First .. Clause_String'First + 5) =
"Annex " then -- Annex clauses.
Clause_Number :=
(Section => Character'Pos(Clause_String (Clause_String'First + 6)) - Character'Pos('A') + ANNEX_START,
Clause | Subclause | Subsubclause => 0);
elsif Clause_String'Length = 1 then
Clause_Number :=
(Section => Get_Section_Number,
Clause | Subclause | Subsubclause => 0);
elsif Clause_String'Length = 2 then
Clause_Number :=
(Section => Get_Section_Number,
Clause | Subclause | Subsubclause => 0);
else
Clause_Number :=
(Section => Get_Section_Number,
Clause | Subclause | Subsubclause => 0);
-- Next is now the start of the Clause:
if Clause_String'Last - Next + 1 = 1 then
Clause_Number.Clause := Get_Clause_Number;
elsif Clause_String'Last - Next + 1 = 2 then
Clause_Number.Clause := Get_Clause_Number;
else
Clause_Number.Clause := Get_Clause_Number;
-- Next is now the start of the Subclause:
if Clause_String'Last - Next + 1 = 1 then
Clause_Number.Subclause := Character'Pos(Clause_String (Next)) - Character'Pos('0');
elsif Clause_String'Last - Next + 1 = 2 then
Clause_Number.Subclause := (Character'Pos(Clause_String (Next)) -
Character'Pos('0')) * 10 +
Character'Pos(Clause_String (Next + 1)) - Character'Pos('0');
else
if Clause_String'Last - Next + 1 = 1 or else
Clause_String(Next + 1) = '.' then
Next := Next + 2;
Clause_Number.Subclause := Character'Pos(Clause_String (Next - 2)) - Character'Pos('0');
else
Next := Next + 3;
Clause_Number.Subclause := (Character'Pos(Clause_String (Next - 3)) - Character'Pos('0')) * 10 +
Character'Pos(Clause_String (Next - 3 + 1)) - Character'Pos('0');
end if;
if Clause_String'Last - Next + 1 = 1 then
Clause_Number.Subsubclause := Character'Pos(Clause_String (Next)) - Character'Pos('0');
else -- Two digit.
Clause_Number.Subsubclause := (Character'Pos(Clause_String (Next)) -
Character'Pos('0')) * 10 +
Character'Pos(Clause_String (Next + 1)) - Character'Pos('0');
end if;
end if;
end if;
end if;
if Clause_Number.Section = UNKNOWN then
raise Bad_Clause_Error with "unknown section number";
-- else not unknown
end if;
end Make_Clause;
function Lookup_Clause_Number (Title : in Title_Type) return String is
-- Given the title of a clause, returns the formatted Section or
-- clause number reference for that title. The Title must match
-- exactly, except for case. Raises Not_Found_Error if not found.
Lower_Title : constant Title_Type := Ada.Characters.Handling.To_Lower (Title);
begin
for I in 1 .. Last_Title loop
if Lower_Title = Title_List(I).Search_Title then
return Make_Clause_Number (Title_List(I).Level,
Title_List(I).Clause_Number);
end if;
end loop;
raise Not_Found_Error;
end Lookup_Clause_Number;
function Lookup_Level (Title : in Title_Type) return Level_Type is
-- Given the title of a clause, returns the level for that title. The Title must match
-- exactly, except for case. Raises Not_Found_Error if not found.
Lower_Title : constant Title_Type := Ada.Characters.Handling.To_Lower (Title);
begin
for I in 1 .. Last_Title loop
if Lower_Title = Title_List(I).Search_Title then
return Title_List(I).Level;
end if;
end loop;
raise Not_Found_Error;
end Lookup_Level;
function Lookup_Title (Level : in Level_Type;
Clause_Number : in Clause_Number_Type) return Title_Type is
-- Given the level and clause numbers, return the appropriate
-- title. Raises Not_Found_Error if not found.
begin
if Clause_Number.Section = UNKNOWN then
raise Bad_Clause_Error with "unknown section number";
-- else not unknown
end if;
for I in 1 .. Last_Title loop
if Title_List(I).Level = Level and then
Title_List(I).Clause_Number = Clause_Number then
return Title_List(I).Title;
end if;
end loop;
raise Not_Found_Error;
end Lookup_Title;
function Lookup_Old_Title (Level : in Level_Type;
Clause_Number : in Clause_Number_Type) return Title_Type is
-- Given the level and clause numbers, return the appropriate
-- old title. Calls Lookup_Title if not found (thus returning the
-- regular (new) title.
begin
if Clause_Number.Section = UNKNOWN then
raise Bad_Clause_Error with "unknown section number";
-- else not unknown
end if;
for I in 1 .. Last_Old_Title loop
if Old_Title_List(I).Level = Level and then
Old_Title_List(I).Clause_Number = Clause_Number then
return Old_Title_List(I).Title;
end if;
end loop;
return Lookup_Title (Level, Clause_Number);
end Lookup_Old_Title;
function Previous_Clause (Clause : in String) return String is
-- Returns the string of the previous clause (in the table of contents)
-- for the properly formatted clause string Clause.
-- Raises Not_Found_Error if not found.
Clause_Number : Clause_Number_Type;
begin
Make_Clause (Clause, Clause_Number);
for I in 1 .. Last_Title loop
if Title_List(I).Clause_Number = Clause_Number then
for J in reverse 1 .. I - 1 loop
if Title_List(J).Level /= Dead_Clause then
return Make_Clause_Number (Title_List(J).Level,
Title_List(J).Clause_Number);
-- else skip it and continue.
end if;
end loop;
-- If we get here, it was not found.
raise Not_Found_Error;
end if;
end loop;
raise Not_Found_Error;
end Previous_Clause;
function Next_Clause (Clause : in String) return String is
-- Returns the string of the next clause (in the table of contents)
-- for the properly formatted clause string Clause.
-- Raises Not_Found_Error if not found.
Clause_Number : Clause_Number_Type;
begin
Make_Clause (Clause, Clause_Number);
for I in 1 .. Last_Title loop
if Title_List(I).Clause_Number = Clause_Number then
for J in I + 1 .. Last_Title loop
if Title_List(J).Level /= Dead_Clause then
return Make_Clause_Number (Title_List(J).Level,
Title_List(J).Clause_Number);
-- else skip it and continue.
end if;
end loop;
-- If we get here, it was not found.
raise Not_Found_Error;
end if;
end loop;
raise Not_Found_Error;
end Next_Clause;
function Parent_Clause (Clause : in String) return String is
-- Returns the string of the parent clause (in the table of contents)
-- for the properly formatted clause string Clause.
--
-- Result is a null string if Clause is a top level clause;
-- Section, Unnumbered_Section, Normative_Annex,
-- Informative_Annex, Plain_Annex.
Clause_Number : Clause_Number_Type;
begin
Make_Clause (Clause, Clause_Number);
if Clause_Number.Clause = 0 then
-- Clause is a section; no parent
return "";
elsif Clause_Number.Subclause = 0 then
-- Clause is a clause; parent is Section or Annex
if Clause_Number.Section >= ANNEX_START then
return Make_Clause_Number (Normative_Annex, (Clause_Number.Section, 0, 0, 0));
else
return Make_Clause_Number (Section, (Clause_Number.Section, 0, 0, 0));
end if;
elsif Clause_Number.Subsubclause = 0 then
-- Clause is a subclause; clause is parent
return Make_Clause_Number (ARM_Contents.Clause, (Clause_Number.Section, Clause_Number.Clause, 0, 0));
else
-- Clause is a subsubclause; subclause is parent
return Make_Clause_Number
(Subclause, (Clause_Number.Section, Clause_Number.Clause, Clause_Number.Subclause, 0));
end if;
end Parent_Clause;
procedure For_Each is
-- Call Operate for each title in the contents, in the order that
-- they were added to the contents (other than dead clauses). If the
-- Quit parameter to Operate is True when Operate returns, the
-- iteration is abandoned.
Quit : Boolean := False;
begin
for I in 1 .. Last_Title loop
if Title_List(I).Level /= Dead_Clause then
Operate (Title_List(I).Title,
Title_List(I).Level,
Title_List(I).Clause_Number,
Title_List(I).Version,
Quit);
-- else skip it.
end if;
if Quit then
return;
end if;
end loop;
end For_Each;
end ARM_Contents;
arm_info-2020.1-src/progs/arm_cont.ads 0000664 0000000 0000000 00000020031 13734156663 0017614 0 ustar 00root root 0000000 0000000 with Ada.Strings.Unbounded;
package ARM_Contents is
--
-- Ada reference manual formatter (ARM_Form).
--
-- This package contains the routines to manage section/clause/subclause
-- references.
--
-- ---------------------------------------
-- Copyright 2000, 2004, 2006, 2007, 2009, 2011, 2012
-- AXE Consultants. All rights reserved.
-- P.O. Box 1512, Madison WI 53701
-- E-Mail: randy@rrsoftware.com
--
-- ARM_Form is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License version 3
-- as published by the Free Software Foundation.
--
-- AXE CONSULTANTS MAKES THIS TOOL AND SOURCE CODE AVAILABLE ON AN "AS IS"
-- BASIS AND MAKES NO WARRANTY, EXPRESS OR IMPLIED, AS TO THE ACCURACY,
-- CAPABILITY, EFFICIENCY, MERCHANTABILITY, OR FUNCTIONING OF THIS TOOL.
-- IN NO EVENT WILL AXE CONSULTANTS BE LIABLE FOR ANY GENERAL,
-- CONSEQUENTIAL, INDIRECT, INCIDENTAL, EXEMPLARY, OR SPECIAL DAMAGES,
-- EVEN IF AXE CONSULTANTS HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-- DAMAGES.
--
-- A copy of the GNU General Public License is available in the file
-- gpl-3-0.txt in the standard distribution of the ARM_Form tool.
-- Otherwise, see .
--
-- If the GPLv3 license is not satisfactory for your needs, a commercial
-- use license is available for this tool. Contact Randy at AXE Consultants
-- for more information.
--
-- ---------------------------------------
--
-- Edit History:
--
-- 4/19/00 - RLB - Created base package.
-- 4/26/00 - RLB - Added Previous_Clause and Next_Clause.
-- 5/15/00 - RLB - Added rules about unnumbered sections.
-- 5/22/00 - RLB - Added Unnumbered_Section level.
-- 8/ 7/00 - RLB - Made Make_Clause visible.
-- 8/22/00 - RLB - Added Old_Title handling.
-- 9/14/04 - RLB - Moved Change_Version_Type here, to avoid mutual
-- dependence.
-- - RLB - Added version to changes.
-- 9/22/06 - RLB - Created type Clause_Number_Type and added SubSubClause.
-- 12/18/07 - RLB - Added Plain_Annex.
-- 5/06/09 - RLB - Added Versioned_String.
-- 5/07/09 - RLB - Added Dead_Clause.
-- 10/18/11 - RLB - Changed to GPLv3 license.
-- 10/19/11 - RLB - Added Parent_Clause from Stephen Leake's version.
-- 10/25/11 - RLB - Added version to Old name strings.
-- 8/30/12 - RLB - Added initialization of Section to UNKNOWN to
-- detect bugs earlier.
subtype Title_Type is String (1 .. 80);
-- The type of a title.
type Section_Number_Type is range 0 .. 58;
-- Values > 30 represent annex letters (31 => A, 32 => B, etc.)
-- Value = 0 represents the preface, introduction, etc. No
-- number is generated if Section_Number = 0.
ANNEX_START : constant := 31; -- First annex section number.
UNKNOWN : constant Section_Number_Type := 58; -- Uninitialized sections get this.
subtype Change_Version_Type is Character range '0' .. '9';
-- Defines the change version. Version 0 is the original text.
type Versioned_String is array (ARM_Contents.Change_Version_Type) of
Ada.Strings.Unbounded.Unbounded_String;
type Clause_Number_Type is record
Section : Section_Number_Type := UNKNOWN;
Clause : Natural := 0;
Subclause : Natural := 0;
Subsubclause : Natural := 0;
end record;
Not_Found_Error : exception;
Bad_Clause_Error : exception;
-- Raised by any of the below if the Clause_Number is
-- invalid (potentially depending on the other parameters,
-- like the level).
procedure Initialize;
-- Initialize this package; make sure the contents are empty.
type Level_Type is (Section, Unnumbered_Section, Plain_Annex,
Normative_Annex, Informative_Annex,
Clause, Subclause, Subsubclause, Dead_Clause);
-- Defines the level of a clause header.
-- Clause is "xx.nn"; Subclause is "xx.nn.nn"; Subsubclause is "xx.nn.nn.nn".
function "<" (Left, Right : Clause_Number_Type) return Boolean;
-- True if Left comes before Right in the collating order.
function ">" (Left, Right : Clause_Number_Type) return Boolean;
-- True if Left comes after Right in the collating order.
function "<=" (Left, Right : Clause_Number_Type) return Boolean;
-- True if Left comes before or is the same as Right in the
-- collating order.
function ">=" (Left, Right : Clause_Number_Type) return Boolean;
-- True if Left comes after or is the same as Right in the
-- collating order.
procedure Add (Title : in Title_Type;
Level : in Level_Type;
Clause_Number : in Clause_Number_Type;
Version : in ARM_Contents.Change_Version_Type := '0');
-- Add a section or clause to the contents. It has the specified
-- characteristics.
procedure Add_Old (Old_Title : in Title_Type;
Level : in Level_Type;
Clause_Number : in Clause_Number_Type;
Version : in ARM_Contents.Change_Version_Type := '0');
-- Add an old title for a section or clause to the contents. It has
-- the specified characteristics; the version is the version for which
-- it first was present in the document.
function Make_Clause_Number (Level : in Level_Type;
Clause_Number : in Clause_Number_Type) return String;
-- Returns a properly formatted Section or clause number reference.
-- Note that an unnumbered section returns a number with a
-- Section_Number of zero (for sorting purposes).
procedure Make_Clause (Clause_String : in String;
Clause_Number : out Clause_Number_Type);
-- Returns the clause number for a properly formatted Section or
-- clause string.
function Lookup_Clause_Number (Title : in Title_Type) return String;
-- Given the title of a clause, returns the formatted Section or
-- clause number reference for that title. The Title must match
-- exactly, except for case. Raises Not_Found_Error if not found.
function Lookup_Level (Title : in Title_Type) return Level_Type;
-- Given the title of a clause, returns the level for that title. The Title must match
-- exactly, except for case. Raises Not_Found_Error if not found.
function Lookup_Title (Level : in Level_Type;
Clause_Number : in Clause_Number_Type) return Title_Type;
-- Given the level and clause numbers, return the appropriate
-- title. Raises Not_Found_Error if not found.
function Lookup_Old_Title (Level : in Level_Type;
Clause_Number : in Clause_Number_Type) return Title_Type;
-- Given the level and clause numbers, return the appropriate
-- old title. Calls Lookup_Title if not found (thus returning the
-- regular (new) title.
function Previous_Clause (Clause : in String) return String;
-- Returns the string of the previous clause (in the table of contents)
-- for the properly formatted clause string Clause.
-- Raises Not_Found_Error if not found.
function Next_Clause (Clause : in String) return String;
-- Returns the string of the next clause (in the table of contents)
-- for the properly formatted clause string Clause.
-- Raises Not_Found_Error if not found.
function Parent_Clause (Clause : in String) return String;
-- Returns the string of the parent clause (in the table of contents)
-- for the properly formatted clause string Clause.
--
-- Result is a null string if Clause is a top level clause;
-- Section, Unnumbered_Section, Normative_Annex,
-- Informative_Annex, Plain_Annex.
generic
with procedure Operate (Title : in Title_Type;
Level : in Level_Type;
Clause_Number : in Clause_Number_Type;
Version : in ARM_Contents.Change_Version_Type;
Quit : out Boolean) is <>;
procedure For_Each;
-- Call Operate for each title in the contents, in the order that
-- they were added to the contents. If the Quit parameter to Operate
-- is True when Operate returns, the iteration is abandoned.
end ARM_Contents;
arm_info-2020.1-src/progs/arm_corr.adb 0000664 0000000 0000000 00000237223 13734156663 0017612 0 ustar 00root root 0000000 0000000 with --ARM_Output,
--ARM_Contents,
--Ada.Text_IO,
Ada.Exceptions,
Ada.Strings.Fixed,
Ada.Strings.Maps;
package body ARM_Corr is
--
-- Ada reference manual formatter (ARM_Form).
--
-- This package defines the text output object.
-- Output objects are responsible for implementing the details of
-- a particular format.
--
-- ---------------------------------------
-- Copyright 2000, 2002, 2004, 2005, 2006, 2007, 2011, 2012
-- AXE Consultants. All rights reserved.
-- P.O. Box 1512, Madison WI 53701
-- E-Mail: randy@rrsoftware.com
--
-- ARM_Form is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License version 3
-- as published by the Free Software Foundation.
--
-- AXE CONSULTANTS MAKES THIS TOOL AND SOURCE CODE AVAILABLE ON AN "AS IS"
-- BASIS AND MAKES NO WARRANTY, EXPRESS OR IMPLIED, AS TO THE ACCURACY,
-- CAPABILITY, EFFICIENCY, MERCHANTABILITY, OR FUNCTIONING OF THIS TOOL.
-- IN NO EVENT WILL AXE CONSULTANTS BE LIABLE FOR ANY GENERAL,
-- CONSEQUENTIAL, INDIRECT, INCIDENTAL, EXEMPLARY, OR SPECIAL DAMAGES,
-- EVEN IF AXE CONSULTANTS HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-- DAMAGES.
--
-- A copy of the GNU General Public License is available in the file
-- gpl-3-0.txt in the standard distribution of the ARM_Form tool.
-- Otherwise, see .
--
-- If the GPLv3 license is not satisfactory for your needs, a commercial
-- use license is available for this tool. Contact Randy at AXE Consultants
-- for more information.
--
-- ---------------------------------------
--
-- Edit History:
--
-- 6/ 2/05 - RLB - Created package from text and HTML versions.
-- 1/11/06 - RLB - Eliminated dispatching Create in favor of tailored
-- versions.
-- 1/18/06 - RLB - Added additional styles.
-- 2/ 8/06 - RLB - Added additional parameters to the table command.
-- 2/10/06 - RLB - Added even more additional parameters to the
-- table command.
-- - RLB - Added picture command.
-- 9/22/06 - RLB - Added missing with.
-- 9/25/06 - RLB - Handled optional renaming of TOC.
-- - RLB - Added Last_Column_Width to Start_Table.
-- 10/13/06 - RLB - Added Local_Link_Start and Local_Link_End to allow
-- formatting in the linked text.
-- 2/ 9/07 - RLB - Changed comments on AI_Reference.
-- 2/13/07 - RLB - Revised to separate style and indent information
-- for paragraphs.
-- 12/18/07 - RLB - Added Plain_Annex.
-- 12/19/07 - RLB - Added limited colors to Text_Format.
-- 10/18/11 - RLB - Changed to GPLv3 license.
-- 10/25/11 - RLB - Added old insertion version to Revised_Clause_Header.
-- 8/31/12 - RLB - Added Output_Path.
-- 10/18/12 - RLB - Added additional hanging styles.
-- 11/26/12 - RLB - Added subdivision names to Clause_Header and
-- Revised_Clause_Header.
LINE_LENGTH : constant := 78;
-- Maximum intended line length.
Special_Set : constant Ada.Strings.Maps.Character_Set :=
Ada.Strings.Maps."or" (Ada.Strings.Maps.To_Set ('>'),
Ada.Strings.Maps.To_Set ('@'));
procedure Create (Output_Object : in out Corr_Output_Type;
File_Prefix : in String;
Output_Path : in String;
Title : in String := "") is
-- Create an Output_Object for a document.
-- The prefix of the output file names is File_Prefix - this
-- should be no more then 5 characters allowed in file names.
-- The result files will be written to Output_Path.
-- The title of the document is Title.
begin
if Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Already valid object");
end if;
Output_Object.Is_Valid := True;
Ada.Strings.Fixed.Move (Target => Output_Object.File_Prefix,
Source => File_Prefix);
Ada.Strings.Fixed.Move (Target => Output_Object.Output_Path,
Source => Output_Path);
Output_Object.Output_Path_Len := Output_Path'Length;
-- We don't use the title.
end Create;
procedure Close (Output_Object : in out Corr_Output_Type) is
-- Close an Output_Object. No further output to the object is
-- allowed after this call.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if Ada.Text_IO.Is_Open (Output_Object.Output_File) then
Ada.Text_IO.Close (Output_Object.Output_File);
end if;
Output_Object.Is_Valid := False;
end Close;
procedure Section (Output_Object : in out Corr_Output_Type;
Section_Title : in String;
Section_Name : in String) is
-- Start a new section. The title is Section_Title (this is
-- intended for humans). The name is Section_Name (this is
-- intended to be suitable to be a portion of a file name).
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Section in paragraph");
end if;
if Ada.Text_IO.Is_Open (Output_Object.Output_File) then
Ada.Text_IO.Close (Output_Object.Output_File);
end if;
-- Create a new file for this section:
-- Unix directory separator for Windows and Debian
Ada.Text_IO.Create (Output_Object.Output_File, Ada.Text_IO.Out_File,
Output_Object.Output_Path(1..Output_Object.Output_Path_Len) &
Ada.Strings.Fixed.Trim (Output_Object.File_Prefix, Ada.Strings.Right) &
"-Corr-" & Section_Name & ".TXT");
Ada.Text_IO.New_Line (Output_Object.Output_File);
end Section;
procedure Set_Columns (Output_Object : in out Corr_Output_Type;
Number_of_Columns : in ARM_Output.Column_Count) is
-- Set the number of columns.
-- Raises Not_Valid_Error if in a paragraph.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"In paragraph");
end if;
-- No columns in text format.
end Set_Columns;
procedure Make_Indent (Output_Object : in out Corr_Output_Type) is
-- Internal:
-- Output the appropriate indent after a New_Line or Put_Line.
begin
--Ada.Text_IO.Put_Line("Make_Indent: Amount=" & Natural'Image(Output_Object.Indent_Amount));
for I in 1 .. Output_Object.Indent_Amount loop
Ada.Text_IO.Put (Output_Object.Output_File, ' ');
end loop;
Output_Object.Char_Count := Output_Object.Indent_Amount;
Output_Object.Out_Char_Count := Output_Object.Indent_Amount;
Output_Object.Output_Buffer_Space_Before := False;
end Make_Indent;
procedure Spill (Output_Object : in out Corr_Output_Type) is
-- Internal:
-- Empty the output buffer in preperation for a New_Line or Put_Line.
begin
if Output_Object.Output_Buffer_Space_Before then
Ada.Text_IO.Put (Output_Object.Output_File, ' ');
Output_Object.Char_Count := Output_Object.Char_Count + 1; -- Count the space.
Output_Object.Out_Char_Count := Output_Object.Out_Char_Count + 1; -- Count the space.
end if;
if Output_Object.Output_Buffer_Len /= 0 then
Ada.Text_IO.Put (Output_Object.Output_File,
Output_Object.Output_Buffer (1 .. Output_Object.Output_Buffer_Len));
--Ada.Text_IO.Put_Line("Spill: Len=" & Natural'Image(Output_Object.Output_Buffer_Len) &
-- " Space added=" & Boolean'Image(Output_Object.Output_Buffer_Space_Before) & " Text=" &
-- Output_Object.Output_Buffer (1 .. Output_Object.Output_Buffer_Len));
Output_Object.Output_Buffer_Len := 0;
Output_Object.Out_Char_Count := Output_Object.Out_Char_Count +
Output_Object.Output_Buffer_Len;
end if;
Output_Object.Output_Buffer_Space_Before := False;
end Spill;
procedure Buffer (Output_Object : in out Corr_Output_Type;
Char : in Character) is
-- Internal:
-- Add Char to the output buffer. Char will *not* be a word break
-- character.
begin
if Output_Object.Output_Buffer_Len = Output_Object.Output_Buffer'Last then
-- Oops, buffer is full. Spill it, and this character.
--Ada.Text_IO.Put_Line("** Buffer overflow!!");
Spill (Output_Object);
Ada.Text_IO.Put (Output_Object.Output_File, Char);
Output_Object.Char_Count := Output_Object.Char_Count + 1;
Output_Object.Out_Char_Count := Output_Object.Out_Char_Count + 1;
return;
end if;
Output_Object.Output_Buffer_Len := Output_Object.Output_Buffer_Len + 1;
Output_Object.Output_Buffer(Output_Object.Output_Buffer_Len) := Char;
Output_Object.Char_Count := Output_Object.Char_Count + 1;
end Buffer;
procedure Buffer (Output_Object : in out Corr_Output_Type;
Str : in String) is
-- Internal:
-- Add Char to the output buffer. String will *not* include a word
-- break character.
begin
if Output_Object.Output_Buffer_Len+Str'Length >= Output_Object.Output_Buffer'Last then
-- Oops, buffer is full. Spill it.
--Ada.Text_IO.Put_Line("** Buffer overflow!!");
Spill (Output_Object);
end if;
Output_Object.Output_Buffer(Output_Object.Output_Buffer_Len+1..Output_Object.Output_Buffer_Len+Str'Length)
:= Str;
Output_Object.Output_Buffer_Len := Output_Object.Output_Buffer_Len + Str'Length;
Output_Object.Char_Count := Output_Object.Char_Count + Str'Length;
end Buffer;
procedure Start_Paragraph (Output_Object : in out Corr_Output_Type;
Style : in ARM_Output.Paragraph_Style_Type;
Indent : in ARM_Output.Paragraph_Indent_Type;
Number : in String;
No_Prefix : in Boolean := False;
Tab_Stops : in ARM_Output.Tab_Info := ARM_Output.NO_TABS;
No_Breaks : in Boolean := False;
Keep_with_Next : in Boolean := False;
Space_After : in ARM_Output.Space_After_Type
:= ARM_Output.Normal;
Justification : in ARM_Output.Justification_Type
:= ARM_Output.Default) is
-- Start a new paragraph. The style and indent of the paragraph is as
-- specified. The (AA)RM paragraph number (which might include update
-- and version numbers as well: [12.1/1]) is Number. If the format is
-- a type with a prefix (bullets, hangining items), the prefix is
-- omitted if No_Prefix is true. Tab_Stops defines the tab stops for
-- the paragraph. If No_Breaks is True, we will try to avoid page breaks
-- in the paragraph. If Keep_with_Next is true, we will try to avoid
-- separating this paragraph and the next one. (These may have no
-- effect in formats that don't have page breaks). Space_After
-- specifies the amount of space following the paragraph. Justification
-- specifies the text justification for the paragraph. Not_Valid_Error
-- is raised if Tab_Stops /= NO_TABS for a hanging or bulleted format.
use type ARM_Output.Paragraph_Indent_Type;
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Already in paragraph");
end if;
Output_Object.Is_In_Paragraph := True;
Output_Object.Is_Hanging := False;
Output_Object.Saw_Hang_End := False;
Output_Object.Char_Count := 0;
Output_Object.Out_Char_Count := 0;
Output_Object.Output_Buffer_Space_Before := False; -- Nothing in it or on the line.
Output_Object.Output_Buffer_Len := 0;
Output_Object.Font := ARM_Output.Default;
Output_Object.Is_Bold := False;
Output_Object.Is_Italic := False;
Output_Object.Size := 0;
Output_Object.Para_Style := Style;
Output_Object.Para_Indent := Indent;
Output_Object.Is_Fixed_Format := False;
if Output_Object.Clause_Len /= 0 and then
Number /= "" then
Ada.Text_IO.New_Line (Output_Object.Output_File);
Ada.Text_IO.Put (Output_Object.Output_File, "!paragraph ");
Ada.Text_IO.Put (Output_Object.Output_File, Output_Object.Clause_Num(1..Output_Object.Clause_Len));
Ada.Text_IO.Put (Output_Object.Output_File, '(');
Ada.Text_IO.Put (Output_Object.Output_File, Number);
Ada.Text_IO.Put (Output_Object.Output_File, ") [");
Ada.Text_IO.Put (Output_Object.Output_File, ARM_Output.Paragraph_Style_Type'Image(Style) &
" :" & ARM_Output.Paragraph_Indent_Type'Image(Indent));
Ada.Text_IO.Put_Line (Output_Object.Output_File, "]");
Ada.Text_IO.New_Line (Output_Object.Output_File);
else
Ada.Text_IO.New_Line (Output_Object.Output_File);
end if;
Output_Object.Indent_Amount := Integer(Indent)*4 + 2;
case Style is
when ARM_Output.Normal =>
if Indent = 0 then
null; -- %% Temp.
Output_Object.Indent_Amount := 0; -- %% Temp.
elsif Indent = 3 then
Ada.Text_IO.Put (Output_Object.Output_File, "@xindent<");
Output_Object.Char_Count := 9;
Output_Object.Indent_Amount := 0; -- %% Temp.
else -- Unknown case.
null; -- ** Tbd.
end if;
when ARM_Output.Wide_Above => null;
if Indent = 0 then
null; -- %% Temp.
Output_Object.Indent_Amount := 0; -- %% Temp.
else -- Unknown case.
null; -- ** Tbd.
end if;
when ARM_Output.Small =>
if Indent = 1 then -- Notes.
Ada.Text_IO.Put (Output_Object.Output_File, "@xindent<@s9<");
Output_Object.Char_Count := 13;
Output_Object.Indent_Amount := 0; -- %% Temp.
else -- Unknown case.
null; -- ** Tbd.
end if;
when ARM_Output.Small_Wide_Above =>
null; -- ** TBD (Unknown cases).
when ARM_Output.Header =>
null; -- ** TBD (Unknown cases).
when ARM_Output.Small_Header =>
if Indent = 1 then -- Notes Header.
null;
--Output_Object.Indent_Amount := 6; --** TBD.
else -- Unknown case.
null; -- ** Tbd.
end if;
when ARM_Output.Index => null; --** TBD.
when ARM_Output.Syntax_Summary => null; --** TBD.
when ARM_Output.Title =>
null; -- ** TBD (Unknown cases).
when ARM_Output.Examples =>
if Indent = 1 then
Ada.Text_IO.Put (Output_Object.Output_File, "@xcode<");
Output_Object.Char_Count := 7;
Output_Object.Is_Fixed_Format := True;
Output_Object.Indent_Amount := 0; -- %% Temp.
else -- Unknown case.
null; -- ** Tbd.
end if;
when ARM_Output.Small_Examples => null; --** TBD.
when ARM_Output.Swiss_Examples =>
if Indent = 1 then
Ada.Text_IO.Put (Output_Object.Output_File, "@xcode<");
Output_Object.Char_Count := 7;
Output_Object.Is_Fixed_Format := True;
Output_Object.Indent_Amount := 0; -- %% Temp.
else -- Unknown case.
null; -- ** Tbd.
end if;
when ARM_Output.Small_Swiss_Examples => null; --** TBD.
when ARM_Output.Bulleted =>
if Indent = 1 then
Output_Object.Indent_Amount := 0; -- %% Temp.
if No_Prefix then
Ada.Text_IO.Put (Output_Object.Output_File, "@xindent<");
Output_Object.Char_Count := 9;
else
Ada.Text_IO.Put (Output_Object.Output_File, "@xbullet<");
Output_Object.Char_Count := 9;
end if;
else -- Unknown/unimplemented case.
null; -- ** Tbd.
end if;
when ARM_Output.Nested_Bulleted => null; --** TBD.
when ARM_Output.Small_Bulleted => null; --** TBD.
when ARM_Output.Small_Nested_Bulleted => null; --** TBD.
when ARM_Output.Giant_Hanging => null; --** TBD.
when ARM_Output.Wide_Hanging =>
if Indent = 3 then
Output_Object.Indent_Amount := 0; -- %% Temp.
Output_Object.Is_Hanging := True;
if No_Prefix then
Output_Object.Saw_Hang_End := True;
Output_Object.Char_Count := 0;
else -- Has prefix
-- No units on first line.
Output_Object.Saw_Hang_End := False;
Ada.Text_IO.Put (Output_Object.Output_File, "@xhang<@xterm<");
Output_Object.Char_Count := 14;
end if;
else -- Unknown/unimplemented case.
null; -- ** Tbd.
end if;
when ARM_Output.Medium_Hanging => null; --** TBD.
when ARM_Output.Narrow_Hanging => null; --** TBD.
when ARM_Output.Hanging_in_Bulleted => null; --** TBD.
when ARM_Output.Small_Giant_Hanging => null; --** TBD.
when ARM_Output.Small_Wide_Hanging => null; --** TBD.
when ARM_Output.Small_Medium_Hanging => null; --** TBD.
when ARM_Output.Small_Narrow_Hanging => null; --** TBD.
when ARM_Output.Small_Hanging_in_Bulleted => null; --** TBD.
when ARM_Output.Enumerated => null; --** TBD.
when ARM_Output.Small_Enumerated => null; --** TBD.
end case;
if Output_Object.Indent_Amount > 6 then
for I in 1 .. (Output_Object.Indent_Amount-6)/4 loop
Ada.Text_IO.Put (Output_Object.Output_File, " ");
Output_Object.Char_Count := Output_Object.Char_Count + 4;
end loop;
end if;
case Style is
when ARM_Output.Normal | ARM_Output.Wide_Above |
ARM_Output.Small | ARM_Output.Small_Wide_Above |
ARM_Output.Header | ARM_Output.Small_Header |
ARM_Output.Index | ARM_Output.Syntax_Summary |
ARM_Output.Title |
ARM_Output.Examples | ARM_Output.Small_Examples |
ARM_Output.Swiss_Examples | ARM_Output.Small_Swiss_Examples =>
Output_Object.Tab_Stops := Tab_Stops;
-- We'll expand proportional stops here (text characters
-- are larger than the variable ones these are set up for).
for I in 1 .. Tab_Stops.Number loop
if ARM_Output."=" (Tab_Stops.Stops(I).Kind,
ARM_Output.Left_Proportional) then
Output_Object.Tab_Stops.Stops(I).Stop :=
(Tab_Stops.Stops(I).Stop * 5 / 4) + Output_Object.Indent_Amount;
else
Output_Object.Tab_Stops.Stops(I).Stop :=
Tab_Stops.Stops(I).Stop + Output_Object.Indent_Amount;
end if;
end loop;
when ARM_Output.Bulleted | ARM_Output.Nested_Bulleted |
ARM_Output.Small_Bulleted | ARM_Output.Small_Nested_Bulleted |
ARM_Output.Giant_Hanging | ARM_Output.Wide_Hanging |
ARM_Output.Medium_Hanging | ARM_Output.Narrow_Hanging |
ARM_Output.Hanging_in_Bulleted |
ARM_Output.Small_Giant_Hanging | ARM_Output.Small_Wide_Hanging |
ARM_Output.Small_Medium_Hanging | ARM_Output.Small_Narrow_Hanging |
ARM_Output.Small_Hanging_in_Bulleted |
ARM_Output.Enumerated | ARM_Output.Small_Enumerated =>
if Tab_Stops.Number /= 0 then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Tabs in hanging/bulleted paragraph");
end if;
end case;
Output_Object.Out_Char_Count := Output_Object.Char_Count;
-- Note: No_Breaks, Keep_with_Next, and Justification have no effect
-- here.
--Ada.Text_IO.Put_Line ("Start_Paragraph - Indent=" & Natural'Image(Output_Object.Indent_Amount) & " Cnt=" &
-- Natural'Image(Output_Object.Char_Count));
end Start_Paragraph;
procedure End_Paragraph (Output_Object : in out Corr_Output_Type) is
-- End a paragraph.
use type ARM_Output.Paragraph_Indent_Type;
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if not Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not in paragraph");
end if;
case Output_Object.Para_Style is
when ARM_Output.Normal =>
if Output_Object.Para_Indent = 0 then
null;
elsif Output_Object.Para_Indent = 3 then
Buffer (Output_Object, '>');
else -- Unknown case.
null; -- ** Tbd.
end if;
when ARM_Output.Wide_Above => null;
if Output_Object.Para_Indent = 0 then
null; -- %% Temp.
else -- Unknown case.
null; -- ** Tbd.
end if;
when ARM_Output.Small =>
if Output_Object.Para_Indent = 1 then -- Notes.
Buffer (Output_Object, ">>");
else -- Unknown case.
null; -- ** Tbd.
end if;
when ARM_Output.Small_Wide_Above =>
null; -- ** TBD (Unknown cases).
when ARM_Output.Header =>
null; -- ** TBD (Unknown cases).
when ARM_Output.Small_Header =>
if Output_Object.Para_Indent = 1 then -- Notes Header.
null;
else -- Unknown case.
null; -- ** Tbd.
end if;
when ARM_Output.Index => null; --** TBD.
when ARM_Output.Syntax_Summary => null; --** TBD.
when ARM_Output.Title => null; --** TBD.
when ARM_Output.Examples =>
if Output_Object.Para_Indent = 1 then
Buffer (Output_Object, '>');
else -- Unknown case.
null; -- ** Tbd.
end if;
when ARM_Output.Small_Examples => null; --** TBD.
when ARM_Output.Swiss_Examples =>
if Output_Object.Para_Indent = 1 then
Buffer (Output_Object, '>');
else -- Unknown case.
null; -- ** Tbd.
end if;
when ARM_Output.Small_Swiss_Examples => null; --** TBD.
when ARM_Output.Bulleted =>
if Output_Object.Para_Indent = 1 then
Buffer (Output_Object, '>');
else -- Unknown/unimplemented case.
null; -- ** Tbd.
end if;
when ARM_Output.Nested_Bulleted => null; --** TBD.
when ARM_Output.Small_Bulleted => null; --** TBD.
when ARM_Output.Small_Nested_Bulleted => null; --** TBD.
when ARM_Output.Giant_Hanging => null; --** TBD.
when ARM_Output.Wide_Hanging =>
if Output_Object.Para_Indent = 3 then
Buffer (Output_Object, '>');
else -- Unknown/unimplemented case.
null; -- ** Tbd.
end if;
when ARM_Output.Medium_Hanging => null; --** TBD.
when ARM_Output.Narrow_Hanging => null; --** TBD.
when ARM_Output.Hanging_in_Bulleted => null; --** TBD.
when ARM_Output.Small_Giant_Hanging => null; --** TBD.
when ARM_Output.Small_Wide_Hanging => null; --** TBD.
when ARM_Output.Small_Medium_Hanging => null; --** TBD.
when ARM_Output.Small_Narrow_Hanging => null; --** TBD.
when ARM_Output.Small_Hanging_in_Bulleted => null; --** TBD.
when ARM_Output.Enumerated => null; --** TBD.
when ARM_Output.Small_Enumerated => null; --** TBD.
end case;
if Output_Object.Output_Buffer_Len /= 0 then
Spill (Output_Object);
end if;
Output_Object.Is_In_Paragraph := False;
Ada.Text_IO.New_Line (Output_Object.Output_File, 2); -- Double space paragraphs.
end End_Paragraph;
procedure Category_Header (Output_Object : in out Corr_Output_Type;
Header_Text : String) is
-- Output a Category header (that is, "Legality Rules",
-- "Dynamic Semantics", etc.)
-- (Note: We did not use a enumeration here to insure that these
-- headers are spelled the same in all output versions).
-- Raises Not_Valid_Error if in a paragraph.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Header in paragraph");
end if;
Ada.Text_IO.New_Line (Output_Object.Output_File);
Ada.Text_IO.Put_Line (Output_Object.Output_File, "!subheader");
Ada.Text_IO.Put (Output_Object.Output_File, "@i<@s8<");
if Ada.Strings.Fixed.Count (Header_Text, Special_Set) = 0 then
Ada.Text_IO.Put (Output_Object.Output_File, Header_Text);
else
for I in Header_Text'Range loop
if Header_Text(I) = '>' then
Ada.Text_IO.Put (Output_Object.Output_File, "@>");
elsif Header_Text(I) = '@' then
Ada.Text_IO.Put (Output_Object.Output_File, "@@");
else
Ada.Text_IO.Put (Output_Object.Output_File, Header_Text(I));
end if;
end loop;
end if;
Ada.Text_IO.Put (Output_Object.Output_File, ">>");
Ada.Text_IO.New_Line (Output_Object.Output_File);
Output_Object.Char_Count := 0;
Output_Object.Out_Char_Count := 0;
end Category_Header;
procedure Clause_Header (Output_Object : in out Corr_Output_Type;
Header_Text : in String;
Level : in ARM_Contents.Level_Type;
Clause_Number : in String;
Top_Level_Subdivision_Name : in ARM_Output.Top_Level_Subdivision_Name_Kind;
No_Page_Break : in Boolean := False) is
-- Output a Clause header. The level of the header is specified
-- in Level. The Clause Number is as specified; the top-level (and
-- other) subdivision names are as specified. These should appear in
-- the table of contents.
-- For hyperlinked formats, this should generate a link target.
-- If No_Page_Break is True, suppress any page breaks.
-- Raises Not_Valid_Error if in a paragraph.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Header in paragraph");
end if;
Ada.Text_IO.New_Line (Output_Object.Output_File);
Output_Object.Clause_Len := Clause_Number'Length;
Output_Object.Clause_Num(1..Output_Object.Clause_Len) :=
Clause_Number;
-- Special for table of contents:
if Clause_Number = "" and then
(Header_Text = "Table of Contents" or else
Header_Text = "Contents") then
Ada.Text_IO.Put (Output_Object.Output_File,
"!clause ");
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Header_Text);
Ada.Text_IO.New_Line (Output_Object.Output_File, 2);
Output_Object.Char_Count := 0;
Output_Object.Out_Char_Count := 0;
return;
end if;
Ada.Text_IO.Put (Output_Object.Output_File,
"!clause ");
case Level is
when ARM_Contents.Plain_Annex =>
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Clause_Number); -- Note: Clause_Number includes "Annex"
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Header_Text);
when ARM_Contents.Normative_Annex =>
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Clause_Number); -- Note: Clause_Number includes "Annex"
Ada.Text_IO.Put_Line (Output_Object.Output_File,
"(normative)");
Ada.Text_IO.New_Line (Output_Object.Output_File);
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Header_Text);
when ARM_Contents.Informative_Annex =>
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Clause_Number); -- Note: Clause_Number includes "Annex"
Ada.Text_IO.Put_Line (Output_Object.Output_File,
"(informative)");
Ada.Text_IO.New_Line (Output_Object.Output_File);
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Header_Text);
when ARM_Contents.Section =>
case Top_Level_Subdivision_Name is
when ARM_Output.Chapter =>
Ada.Text_IO.Put_Line (Output_Object.Output_File,
"Chapter " & Clause_Number & ": " & Header_Text);
when ARM_Output.Section =>
Ada.Text_IO.Put_Line (Output_Object.Output_File,
"Section " & Clause_Number & ": " & Header_Text);
when ARM_Output.Clause =>
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Clause_Number & " " & Header_Text);
end case;
when ARM_Contents.Unnumbered_Section =>
if Header_Text /= "" then
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Header_Text);
end if;
when ARM_Contents.Clause | ARM_Contents.Subclause |
ARM_Contents.Subsubclause =>
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Clause_Number & ' ' & Header_Text);
when ARM_Contents.Dead_Clause =>
raise Program_Error; -- No headers for dead clauses.
end case;
Ada.Text_IO.New_Line (Output_Object.Output_File, 2);
Output_Object.Char_Count := 0;
Output_Object.Out_Char_Count := 0;
-- We don't have any page breaks here to suppress.
end Clause_Header;
procedure Revised_Clause_Header
(Output_Object : in out Corr_Output_Type;
New_Header_Text : in String;
Old_Header_Text : in String;
Level : in ARM_Contents.Level_Type;
Clause_Number : in String;
Version : in ARM_Contents.Change_Version_Type;
Old_Version : in ARM_Contents.Change_Version_Type;
Top_Level_Subdivision_Name : in ARM_Output.Top_Level_Subdivision_Name_Kind;
No_Page_Break : in Boolean := False) is
-- Output a revised clause header. Both the original and new text will
-- be output. The level of the header is specified in Level. The Clause
-- Number is as specified; the top-level (and other) subdivision names
-- are as specified. These should appear in the table of contents.
-- For hyperlinked formats, this should generate a link target.
-- Version is the insertion version of the new text; Old_Version is
-- the insertion version of the old text.
-- If No_Page_Break is True, suppress any page breaks.
-- Raises Not_Valid_Error if in a paragraph.
function Header_Text return String is
-- Note: Version and Old_Version are not used.
begin
return '{' & New_Header_Text & "} [" & Old_Header_Text & ']';
end Header_Text;
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Header in paragraph");
end if;
Ada.Text_IO.New_Line (Output_Object.Output_File);
Output_Object.Clause_Len := Clause_Number'Length;
Output_Object.Clause_Num(1..Output_Object.Clause_Len) :=
Clause_Number;
-- Special for table of contents:
if Clause_Number = "" and then
(Header_Text = "Table of Contents" or else -- Ada 95 format
Header_Text = "Contents") then -- ISO 2004 format.
Ada.Text_IO.Put (Output_Object.Output_File,
"!clause ");
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Header_Text);
Ada.Text_IO.New_Line (Output_Object.Output_File, 2);
Output_Object.Char_Count := 0;
Output_Object.Out_Char_Count := 0;
return;
end if;
Ada.Text_IO.Put (Output_Object.Output_File,
"!clause ");
case Level is
when ARM_Contents.Plain_Annex =>
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Clause_Number); -- Note: Clause_Number includes "Annex"
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Header_Text);
when ARM_Contents.Normative_Annex =>
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Clause_Number); -- Note: Clause_Number includes "Annex"
Ada.Text_IO.Put_Line (Output_Object.Output_File,
"(normative)");
Ada.Text_IO.New_Line (Output_Object.Output_File);
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Header_Text);
when ARM_Contents.Informative_Annex =>
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Clause_Number); -- Note: Clause_Number includes "Annex"
Ada.Text_IO.Put_Line (Output_Object.Output_File,
"(informative)");
Ada.Text_IO.New_Line (Output_Object.Output_File);
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Header_Text);
when ARM_Contents.Section =>
case Top_Level_Subdivision_Name is
when ARM_Output.Chapter =>
Ada.Text_IO.Put_Line (Output_Object.Output_File,
"Chapter " & Clause_Number & ": " & Header_Text);
when ARM_Output.Section =>
Ada.Text_IO.Put_Line (Output_Object.Output_File,
"Section " & Clause_Number & ": " & Header_Text);
when ARM_Output.Clause =>
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Clause_Number & " " & Header_Text);
end case;
when ARM_Contents.Unnumbered_Section =>
if Header_Text /= "" then
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Header_Text);
end if;
when ARM_Contents.Clause | ARM_Contents.Subclause |
ARM_Contents.Subsubclause =>
Ada.Text_IO.Put_Line (Output_Object.Output_File,
Clause_Number & ' ' & Header_Text);
when ARM_Contents.Dead_Clause =>
raise Program_Error; -- No headers for dead clauses.
end case;
Ada.Text_IO.New_Line (Output_Object.Output_File, 2);
Output_Object.Char_Count := 0;
Output_Object.Out_Char_Count := 0;
-- We don't have any page breaks here to suppress.
end Revised_Clause_Header;
procedure TOC_Marker (Output_Object : in out Corr_Output_Type;
For_Start : in Boolean) is
-- Mark the start (if For_Start is True) or end (if For_Start is
-- False) of the table of contents data. Output objects that
-- auto-generate the table of contents can use this to do needed
-- actions.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
null; -- We don't care about this.
end TOC_Marker;
procedure New_Page (Output_Object : in out Corr_Output_Type;
Kind : ARM_Output.Page_Kind_Type := ARM_Output.Any_Page) is
-- Output a page break.
-- Note that this has no effect on non-printing formats.
-- Any_Page breaks to the top of the next page (whatever it is);
-- Odd_Page_Only breaks to the top of the odd-numbered page;
-- Soft_Page allows a page break but does not force one (use in
-- "No_Breaks" paragraphs.)
-- Raises Not_Valid_Error if in a paragraph if Kind = Any_Page or
-- Odd_Page, and if not in a paragraph if Kind = Soft_Page.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
case Kind is
when ARM_Output.Any_Page | ARM_Output.Odd_Page_Only =>
if Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Page in paragraph");
end if;
Ada.Text_IO.New_Line (Output_Object.Output_File, 2);
when ARM_Output.Soft_Page =>
if not Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Soft page not in paragraph");
end if;
null; -- No page breaks.
Spill (Output_Object);
end case;
end New_Page;
procedure New_Column (Output_Object : in out Corr_Output_Type) is
-- Output a column break.
-- Raises Not_Valid_Error if in a paragraph, or if the number of
-- columns is 1.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"New column in paragraph");
end if;
-- No columns in text format.
Ada.Text_IO.New_Line (Output_Object.Output_File);
end New_Column;
procedure Start_Table (Output_Object : in out Corr_Output_Type;
Columns : in ARM_Output.Column_Count;
First_Column_Width : in ARM_Output.Column_Count;
Last_Column_Width : in ARM_Output.Column_Count;
Alignment : in ARM_Output.Column_Text_Alignment;
No_Page_Break : in Boolean;
Has_Border : in Boolean;
Small_Text_Size : in Boolean;
Header_Kind : in ARM_Output.Header_Kind_Type) is
-- Starts a table. The number of columns is Columns; the first
-- column has First_Column_Width times the normal column width, and
-- the last column has Last_Column_Width times the normal column width.
-- Alignment is the horizontal text alignment within the columns.
-- No_Page_Break should be True to keep the table intact on a single
-- page; False to allow it to be split across pages.
-- Has_Border should be true if a border is desired, false otherwise.
-- Small_Text_Size means that the contents will have the AARM size;
-- otherwise it will have the normal size.
-- Header_Kind determines whether the table has headers.
-- This command starts a paragraph; the entire table is a single
-- paragraph. Text will be considered part of the caption until the
-- next table marker call.
-- Raises Not_Valid_Error if in a paragraph.
begin
-- Alignment, No_Page_Break, Border, Small_Text_Size, and Header_Kind
-- not used here.
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Table in paragraph");
end if;
Output_Object.Tab_Stops.Number := Columns;
declare
Column_Units : constant ARM_Output.Column_Count :=
Columns+First_Column_Width+Last_Column_Width-2;
Width : Natural :=
(72/(Column_Units));
begin
if Column_Units <= 3 then -- Keep it from getting too wide.
Width := 22;
end if;
for I in 1 .. Columns loop
Output_Object.Tab_Stops.Stops(I) := (Kind => ARM_Output.Left_Fixed,
Stop => Width*(I+First_Column_Width-1)+10);
end loop;
end;
Output_Object.Indent_Amount := 10;
Ada.Text_IO.Put (Output_Object.Output_File, " ");
Output_Object.Char_Count := 10;
Output_Object.Out_Char_Count := 10;
Output_Object.Is_In_Paragraph := True;
Output_Object.Is_In_Table := True;
end Start_Table;
procedure Table_Marker (Output_Object : in out Corr_Output_Type;
Marker : in ARM_Output.Table_Marker_Type) is
-- Marks the end of an entity in a table.
-- If Marker is End_Caption, the table caption ends and the
-- future text is part of the table header.
-- If Marker is End_Header, the table header ends and the
-- future text is part of the table body.
-- If Marker is End_Row, a row in the table is completed, and another
-- row started.
-- If Marker is End_Row_Next_Is_Last, a row in the table is completed,
-- and another row started. That row is the last row in the table.
-- If Marker is End_Item, an item in the table header or body is ended,
-- and another started.
-- If Marker is End_Table, the entire table is finished.
-- Raises Not_Valid_Error if not in a table.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if (not Output_Object.Is_In_Paragraph) or (not Output_Object.Is_In_Table) then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Table marker not in table");
end if;
case Marker is
when ARM_Output.End_Item =>
-- Just tab over one row:
Spill (Output_Object);
Ada.Text_IO.Put_Line (Output_Object.Output_File, " ");
Output_Object.Char_Count := Output_Object.Char_Count + 1;
Output_Object.Out_Char_Count := Output_Object.Out_Char_Count + 1;
for I in 1 .. Output_Object.Tab_Stops.Number loop
if Output_Object.Tab_Stops.Stops(I).Stop > Output_Object.Char_Count then
for J in Output_Object.Char_Count+1 .. Output_Object.Tab_Stops.Stops(I).Stop-1 loop
Ada.Text_IO.Put_Line (Output_Object.Output_File, " ");
Output_Object.Char_Count := Output_Object.Char_Count + 1;
Output_Object.Out_Char_Count := Output_Object.Out_Char_Count + 1;
end loop;
end if;
end loop;
when ARM_Output.End_Caption =>
Spill (Output_Object);
Ada.Text_IO.New_Line (Output_Object.Output_File, 2);
Ada.Text_IO.Put (Output_Object.Output_File, " ");
Output_Object.Char_Count := 10;
Output_Object.Out_Char_Count := 10;
when ARM_Output.End_Header =>
Spill (Output_Object);
Ada.Text_IO.New_Line (Output_Object.Output_File, 2);
Ada.Text_IO.Put (Output_Object.Output_File, " ");
Output_Object.Char_Count := 10;
Output_Object.Out_Char_Count := 10;
when ARM_Output.End_Row | ARM_Output.End_Row_Next_Is_Last =>
Spill (Output_Object);
Ada.Text_IO.New_Line (Output_Object.Output_File, 1);
Ada.Text_IO.Put (Output_Object.Output_File, " ");
Output_Object.Char_Count := 10;
Output_Object.Out_Char_Count := 10;
when ARM_Output.End_Table =>
Spill (Output_Object);
Output_Object.Is_In_Paragraph := False;
Output_Object.Is_In_Table := False;
Ada.Text_IO.New_Line (Output_Object.Output_File);
Output_Object.Tab_Stops := ARM_Output.NO_TABS;
end case;
end Table_Marker;
procedure Separator_Line (Output_Object : in out Corr_Output_Type;
Is_Thin : Boolean := True) is
-- Output a separator line. It is thin if "Is_Thin" is true.
-- Raises Not_Valid_Error if in a paragraph.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Separator in paragraph");
end if;
Ada.Text_IO.New_Line (Output_Object.Output_File);
if Is_Thin then
Ada.Text_IO.Put_Line (Output_Object.Output_File, "---------------------------------------------------------------------");
else
Ada.Text_IO.Put_Line (Output_Object.Output_File, "=====================================================================");
end if;
Ada.Text_IO.New_Line (Output_Object.Output_File);
end Separator_Line;
-- Text output: These are only allowed after a Start_Paragraph and
-- before any End_Paragraph. Raises Not_Valid_Error if not allowed.
procedure Ordinary_Text (Output_Object : in out Corr_Output_Type;
Text : in String) is
-- Output ordinary text.
-- The text must end at a word break, never in the middle of a word.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if not Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not in paragraph");
end if;
--Ada.Text_IO.Put_Line ("Ordinary_Text: Cnt=" & Natural'Image(Output_Object.Char_Count) &
--" Buffer=" & Natural'Image(Output_Object.Output_Buffer_Len));
if Output_Object.Char_Count + Text'Length >= LINE_LENGTH - 2 and then
Output_Object.Out_Char_Count > Output_Object.Indent_Amount then
-- We want a line break here if the line is too long and something was output:
Ada.Text_IO.New_Line (Output_Object.Output_File);
Make_Indent (Output_Object);
--Output_Object.Output_Buffer_Space_Before := False;
-- Start of line, this is done by Make_Indent.
Spill (Output_Object);
else
Spill (Output_Object);
end if;
if Ada.Strings.Fixed.Count (Text, Special_Set) = 0 then
Ada.Text_IO.Put (Output_Object.Output_File, Text);
Output_Object.Char_Count := Output_Object.Char_Count + Text'Length;
Output_Object.Out_Char_Count := Output_Object.Out_Char_Count + Text'Length;
else
for I in Text'Range loop
if Text(I) = '>' then
Ada.Text_IO.Put (Output_Object.Output_File, "@>");
Output_Object.Char_Count := Output_Object.Char_Count + 2;
Output_Object.Out_Char_Count := Output_Object.Out_Char_Count + 2;
elsif Text(I) = '@' then
Ada.Text_IO.Put (Output_Object.Output_File, "@@");
Output_Object.Char_Count := Output_Object.Char_Count + 2;
Output_Object.Out_Char_Count := Output_Object.Out_Char_Count + 2;
else
Ada.Text_IO.Put (Output_Object.Output_File, Text(I));
Output_Object.Char_Count := Output_Object.Char_Count + 1;
Output_Object.Out_Char_Count := Output_Object.Out_Char_Count + 1;
end if;
end loop;
end if;
Output_Object.Output_Buffer_Space_Before := False; -- No space between
-- this and any following text.
end Ordinary_Text;
procedure Ordinary_Character (Output_Object : in out Corr_Output_Type;
Char : in Character) is
-- Output an ordinary character.
-- Spaces will be used to break lines as needed.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if not Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not in paragraph");
end if;
if Output_Object.Char_Count >= LINE_LENGTH and then
Output_Object.Out_Char_Count > Output_Object.Indent_Amount then
-- Insert a break here if anything has been output (but don't
-- Spill the buffer):
--Ada.Text_IO.Put_Line ("Ordinary_Char [Break, no spill]: Cnt=" & Natural'Image(Output_Object.Char_Count));
Ada.Text_IO.New_Line (Output_Object.Output_File);
Make_Indent (Output_Object);
--Output_Object.Output_Buffer_Space_Before := False;
-- Start of line, this is done by Make_Indent.
-- Note that this may make the space disappear.
-- Add the contents of the buffer to the character count for this line:
Output_Object.Char_Count := Output_Object.Char_Count +
Output_Object.Output_Buffer_Len;
if Char = '>' then
Buffer (Output_Object, "@>");
elsif Char = '@' then
Buffer (Output_Object, "@@");
elsif Char /= ' ' then
Buffer (Output_Object, Char);
else -- Break character, spill on the new line:
if Output_Object.Output_Buffer_Len /= 0 then
Spill (Output_Object); -- Output the buffer up to the space.
Output_Object.Output_Buffer_Space_Before := True; -- Mid-line now.
-- else nothing in buffer, so nothing to output; just skip it.
end if;
end if;
elsif Char = ' ' then
-- Break character, and it fits on this line:
if Output_Object.Output_Buffer_Len /= 0 then
--Ada.Text_IO.Put_Line ("Ordinary_Char [Space spill]: Cnt=" & Natural'Image(Output_Object.Char_Count));
Spill (Output_Object); -- Output the buffer up to the space.
Output_Object.Output_Buffer_Space_Before := True; -- Mid-line now.
else -- nothing in buffer.
-- nothing to output. But make sure we display a space before
-- the next item.
Output_Object.Output_Buffer_Space_Before := True; -- Mid-line now.
end if;
elsif Char = '>' then
Buffer (Output_Object, "@>");
elsif Char = '@' then
Buffer (Output_Object, "@@");
else
Buffer (Output_Object, Char);
end if;
end Ordinary_Character;
procedure Hard_Space (Output_Object : in out Corr_Output_Type) is
-- Output a hard space. No line break should happen at a hard space.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if not Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not in paragraph");
end if;
if Output_Object.Is_Fixed_Format then
-- In this format, all spaces are hard spaces.
Buffer (Output_Object, ' ');
else -- A hard space command.
Buffer (Output_Object, "@ ");
end if;
end Hard_Space;
procedure Line_Break (Output_Object : in out Corr_Output_Type) is
-- Output a line break. This does not start a new paragraph.
-- This corresponds to a "
" in HTML.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if not Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not in paragraph");
end if;
--Ada.Text_Io.Put_Line ("Line_Break");
if Output_Object.Is_Fixed_Format then
-- In this format, all line breaks are significant.
null;
else -- A hard space command.
Buffer (Output_Object, "@hr");
end if;
if Output_Object.Output_Buffer_Len /= 0 then
Spill (Output_Object);
end if;
Ada.Text_IO.New_Line (Output_Object.Output_File);
Make_Indent (Output_Object);
end Line_Break;
procedure Index_Line_Break (Output_Object : in out Corr_Output_Type;
Clear_Keep_with_Next : in Boolean) is
-- Output a line break for the index. This does not start a new
-- paragraph in terms of spacing. This corresponds to a "
"
-- in HTML. If Clear_Keep_with_Next is true, insure that the next
-- line does not require the following line to stay with it.
-- Raises Not_Valid_Error if the paragraph is not in the index format.
begin
Line_Break (Output_Object);
end Index_Line_Break;
procedure Soft_Line_Break (Output_Object : in out Corr_Output_Type) is
-- Output a soft line break. This is a place (in the middle of a
-- "word") that we allow a line break. It is usually used after
-- underscores in long non-terminals.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if not Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not in paragraph");
end if;
-- if Output_Object.Char_Count >= LINE_LENGTH - 10 then
-- if Output_Object.Output_Buffer_Len /= 0 then
-- Spill (Output_Object);
-- end if;
-- Ada.Text_IO.New_Line (Output_Object.Output_File);
-- Make_Indent (Output_Object);
-- -- else we don't need a line break.
-- end if;
null; -- Ignore this, there is no counterpart in Corrigendum formatting.
end Soft_Line_Break;
procedure Soft_Hyphen_Break (Output_Object : in out Corr_Output_Type) is
-- Output a soft line break, with a hyphen. This is a place (in the middle of
-- a "word") that we allow a line break. If the line break is used,
-- a hyphen will be added to the text.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if not Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not in paragraph");
end if;
-- if Output_Object.Char_Count >= LINE_LENGTH - 8 then
-- Spill (Output_Object);
-- Ada.Text_IO.Put_Line (Output_Object.Output_File, "-"); -- Add the hyphen and break.
-- Make_Indent (Output_Object);
-- -- else we don't need a line break.
-- end if;
null; -- Ignore this, there is no counterpart in Corrigendum formatting.
end Soft_Hyphen_Break;
procedure Tab (Output_Object : in out Corr_Output_Type) is
-- Output a tab, inserting space up to the next tab stop.
-- Raises Not_Valid_Error if the paragraph was created with
-- Tab_Stops = ARM_Output.NO_TABS.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if not Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not in paragraph");
end if;
if ARM_Output."="(Output_Object.Tab_Stops, ARM_Output.NO_TABS) then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Tab, but none set");
end if;
-- We use the tab stops as characters here, and fixed and proportional
-- stops are treated identically.
-- Find the first stop greater than the current character count. (After
-- writing a space).
--Ada.Text_IO.Put_Line ("Tab");
Buffer (Output_Object, "@tab");
Output_Object.Output_Buffer_Space_Before := False; -- Spaces needed were output.
end Tab;
procedure Special_Character (Output_Object : in out Corr_Output_Type;
Char : in ARM_Output.Special_Character_Type) is
-- Output an special character.
begin
--** Could use Latin1 and Unicode equivalents for most of these.
case Char is
when ARM_Output.EM_Dash =>
Buffer (Output_Object, "@emdash");
when ARM_Output.EN_Dash =>
Buffer (Output_Object, "@endash");
when ARM_Output.GEQ =>
Ordinary_Text (Output_Object, ">="); -- Not available in Corrigendum, use the Ada one.
when ARM_Output.LEQ =>
Ordinary_Text (Output_Object, "<="); -- Not available in Corrigendum, use the Ada one.
when ARM_Output.NEQ =>
Ordinary_Text (Output_Object, "/="); -- Not available in Corrigendum, use the Ada one.
when ARM_Output.PI =>
Buffer (Output_Object, "@pi");
when ARM_Output.Left_Ceiling =>
Ordinary_Text (Output_Object, "Ceiling("); -- Not available in Corrigendum.
when ARM_Output.Right_Ceiling =>
Ordinary_Text (Output_Object, ")"); -- Not available in Corrigendum.
when ARM_Output.Left_Floor =>
Ordinary_Text (Output_Object, "Floor("); -- Not available in Corrigendum.
when ARM_Output.Right_Floor =>
Ordinary_Text (Output_Object, ")"); -- Not available in Corrigendum.
when ARM_Output.Thin_Space =>
Ordinary_Text (Output_Object, " "); -- Not available in Corrigendum.
when ARM_Output.Left_Quote =>
Buffer (Output_Object, "@lquote");
when ARM_Output.Right_Quote =>
Buffer (Output_Object, "@rquote");
when ARM_Output.Left_Double_Quote =>
Ordinary_Text (Output_Object, """"); -- Not available in Corrigendum, use double quote.
when ARM_Output.Right_Double_Quote =>
Ordinary_Text (Output_Object, """"); -- Not available in Corrigendum, use double quote.
when ARM_Output.Small_Dotless_I =>
Ordinary_Text (Output_Object, "i"); -- Not available in Corrigendum, use the nearest text.
when ARM_Output.Capital_Dotted_I =>
Ordinary_Text (Output_Object, "I"); -- Not available in Corrigendum, use the nearest text.
end case;
end Special_Character;
procedure Unicode_Character (Output_Object : in out Corr_Output_Type;
Char : in ARM_Output.Unicode_Type) is
-- Output a Unicode character, with code position Char.
Char_Code : constant String := ARM_Output.Unicode_Type'Image(Char);
begin
-- We don't check, but we assume this is not a normal character.
Buffer (Output_Object, "@unicode<" & Char_Code(2..Char_Code'Last) & ">");
end Unicode_Character;
procedure End_Hang_Item (Output_Object : in out Corr_Output_Type) is
-- Marks the end of a hanging item. Call only once per paragraph.
-- Raises Not_Valid_Error if the paragraph style is not in
-- Text_Prefixed_Style_Subtype, or if this has already been
-- called for the current paragraph, or if the paragraph was started
-- with No_Prefix = True.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if not Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not in paragraph");
end if;
if not Output_Object.Is_Hanging then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not a hanging paragraph");
end if;
if Output_Object.Saw_Hang_End then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Already saw the end of the hanging part");
end if;
Output_Object.Saw_Hang_End := True;
Buffer (Output_Object, ">"); -- Close @Xterm<
end End_Hang_Item;
procedure Text_Format (Output_Object : in out Corr_Output_Type;
Format : in ARM_Output.Format_Type) is
-- Change the text format so that all of the properties are as specified.
-- Note: Changes to these properties ought be stack-like; that is,
-- Bold on, Italic on, Italic off, Bold off is OK; Bold on, Italic on,
-- Bold off, Italic off should be avoided (as separate commands).
use type ARM_Output.Change_Type;
use type ARM_Output.Location_Type;
use type ARM_Output.Size_Type;
-- Note: We ignore colors here, no colors in !Corrigendum markup.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if not Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not in paragraph");
end if;
if not Format.Bold and Output_Object.Is_Bold then
Buffer (Output_Object, '>');
Output_Object.Is_Bold := False;
end if;
if not Format.Italic and Output_Object.Is_Italic then
Buffer (Output_Object, '>');
Output_Object.Is_Italic := False;
end if;
if Format.Size /= Output_Object.Size then
if Output_Object.Size /= 0 then
Buffer (Output_Object, '>');
end if;
end if;
-- if Format.Location /= Output_Object.Location then
-- if Output_Object.Location /= ARM_Output.Normal then
-- --Buffer (Output_Object, '>');
-- null; -- Corrigendum doesn't support this.
-- end if;
-- end if;
if ARM_Output."/=" (Format.Font, Output_Object.Font) then
case Output_Object.Font is
when ARM_Output.Default => null;
when ARM_Output.Fixed =>
Buffer (Output_Object, '>');
when ARM_Output.Roman =>
Buffer (Output_Object, '>');
when ARM_Output.Swiss =>
Buffer (Output_Object, '>');
end case;
end if;
-- For the intended purpose, there should be no Change commands.
if Format.Change /= Output_Object.Change then
if Format.Change = ARM_Output.Both then
-- Open only the one(s) needed:
case Output_Object.Change is
-- Note: Version is not used.
when ARM_Output.Insertion =>
-- Open the deletion:
Buffer(Output_Object, '[');
when ARM_Output.Deletion =>
-- Open the insertion:
Buffer(Output_Object, '{');
when ARM_Output.None =>
Buffer(Output_Object, '{');
Buffer(Output_Object, '[');
when ARM_Output.Both =>
null;
end case;
elsif Output_Object.Change = ARM_Output.Both then
-- Close only the one(s) needed:
case Format.Change is
-- Note: Version is not used.
when ARM_Output.Insertion =>
-- Close the deletion:
Buffer(Output_Object, ']');
when ARM_Output.Deletion =>
-- Close the insertion:
Buffer(Output_Object, '}');
when ARM_Output.None =>
Buffer(Output_Object, ']');
Buffer(Output_Object, '}');
when ARM_Output.Both =>
null;
end case;
else -- Both can't get here.
case Output_Object.Change is
when ARM_Output.Insertion =>
Buffer(Output_Object, '}');
when ARM_Output.Deletion =>
Buffer(Output_Object, ']');
when ARM_Output.None =>
null;
when ARM_Output.Both =>
Buffer(Output_Object, ']');
Buffer(Output_Object, '}');
end case;
case Format.Change is
-- Note: Version is not used.
when ARM_Output.Insertion =>
Buffer(Output_Object, '{');
when ARM_Output.Deletion =>
Buffer(Output_Object, '[');
when ARM_Output.None =>
null;
when ARM_Output.Both =>
Buffer(Output_Object, '{');
Buffer(Output_Object, '[');
end case;
end if;
Output_Object.Change := Format.Change;
end if;
if ARM_Output."/=" (Format.Font, Output_Object.Font) then
case Format.Font is
when ARM_Output.Default => null;
when ARM_Output.Fixed =>
Buffer (Output_Object, "@fc<");
when ARM_Output.Roman =>
Buffer (Output_Object, "@ft<");
when ARM_Output.Swiss =>
Buffer (Output_Object, "@fa<");
end case;
Output_Object.Font := Format.Font;
end if;
if Format.Location /= Output_Object.Location then
case Format.Location is
when ARM_Output.Superscript =>
--Buffer (Output_Object, "@+<");
null; -- Corrigendum doesn't support this.
when ARM_Output.Subscript =>
--Buffer (Output_Object, "@+<");
null; -- Corrigendum doesn't support this.
when ARM_Output.Normal =>
null;
end case;
Output_Object.Location := Format.Location;
end if;
if Format.Size /= Output_Object.Size then
if Format.Size < 0 then
Buffer (Output_Object, "@s" & Character'Val(10+Format.Size+Character'Pos('0')) & '<');
else
Buffer (Output_Object, "@s1" & Character'Val(Format.Size+Character'Pos('0')) & '<');
end if;
Output_Object.Size := Format.Size;
end if;
if Format.Italic and (not Output_Object.Is_Italic) then
Buffer (Output_Object, "@i<");
Output_Object.Is_Italic := True;
end if;
if Format.Bold and (not Output_Object.Is_Bold) then
Buffer (Output_Object, "@b<");
Output_Object.Is_Bold := True;
end if;
end Text_Format;
procedure Clause_Reference (Output_Object : in out Corr_Output_Type;
Text : in String;
Clause_Number : in String) is
-- Generate a reference to a clause in the standard. The text of
-- the reference is "Text", and the number of the clause is
-- Clause_Number. For hyperlinked formats, this should generate
-- a link; for other formats, the text alone is generated.
begin
Ordinary_Text (Output_Object, Text); -- Nothing special in this format.
end Clause_Reference;
procedure Index_Target (Output_Object : in out Corr_Output_Type;
Index_Key : in Natural) is
-- Generate a index target. This marks the location where an index
-- reference occurs. Index_Key names the index item involved.
-- For hyperlinked formats, this should generate a link target;
-- for other formats, nothing is generated.
begin
if not Output_Object.Is_Valid then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not valid object");
end if;
if not Output_Object.Is_In_Paragraph then
Ada.Exceptions.Raise_Exception (ARM_Output.Not_Valid_Error'Identity,
"Not in paragraph");
end if;
null; -- Nothing to do for plain text.
end Index_Target;
procedure Index_Reference (Output_Object : in out Corr_Output_Type;
Text : in String;
Index_Key : in Natural;
Clause_Number : in String) is
-- Generate a reference to an index target in the standard. The text
-- of the reference is "Text", and Index_Key and Clause_Number denotes
-- the target. For hyperlinked formats, this should generate
-- a link; for other formats, the text alone is generated.
begin
Ordinary_Text (Output_Object, Text); -- Nothing special in this format.
end Index_Reference;
procedure DR_Reference (Output_Object : in out Corr_Output_Type;
Text : in String;
DR_Number : in String) is
-- Generate a reference to an DR from the standard. The text
-- of the reference is "Text", and DR_Number denotes
-- the target. For hyperlinked formats, this should generate
-- a link; for other formats, the text alone is generated.
begin
Ordinary_Text (Output_Object, Text); -- Nothing special in this format.
end DR_Reference;
procedure AI_Reference (Output_Object : in out Corr_Output_Type;
Text : in String;
AI_Number : in String) is
-- Generate a reference to an AI from the standard. The text
-- of the reference is "Text", and AI_Number denotes
-- the target (in unfolded format). For hyperlinked formats, this
-- should generate a link; for other formats, the text alone is
-- generated.
begin
Ordinary_Text (Output_Object, Text); -- Nothing special in this format.
end AI_Reference;
procedure Local_Target (Output_Object : in out Corr_Output_Type;
Text : in String;
Target : in String) is
-- Generate a local target. This marks the potential target of local
-- links identified by "Target". Text is the text of the target.
-- For hyperlinked formats, this should generate a link target;
-- for other formats, only the text is generated.
begin
Ordinary_Text (Output_Object, Text); -- Nothing special in this format.
end Local_Target;
procedure Local_Link (Output_Object : in out Corr_Output_Type;
Text : in String;
Target : in String;
Clause_Number : in String) is
-- Generate a local link to the target and clause given.
-- Text is the text of the link.
-- For hyperlinked formats, this should generate a link;
-- for other formats, only the text is generated.
begin
Ordinary_Text (Output_Object, Text); -- Nothing special in this format.
end Local_Link;
procedure Local_Link_Start (Output_Object : in out Corr_Output_Type;
Target : in String;
Clause_Number : in String) is
-- Generate a local link to the target and clause given.
-- The link will surround text until Local_Link_End is called.
-- Local_Link_End must be called before this routine can be used again.
-- For hyperlinked formats, this should generate a link;
-- for other formats, only the text is generated.
begin
null; -- No link, nothing to do.
end Local_Link_Start;
procedure Local_Link_End (Output_Object : in out Corr_Output_Type;
Target : in String;
Clause_Number : in String) is
-- End a local link for the target and clause given.
-- This must be in the same paragraph as the Local_Link_Start.
-- For hyperlinked formats, this should generate a link;
-- for other formats, only the text is generated.
begin
null; -- No link, nothing to do.
end Local_Link_End;
procedure URL_Link (Output_Object : in out Corr_Output_Type;
Text : in String;
URL : in String) is
-- Generate a link to the URL given.
-- Text is the text of the link.
-- For hyperlinked formats, this should generate a link;
-- for other formats, only the text is generated.
begin
Ordinary_Text (Output_Object, Text); -- Nothing special in this format.
end URL_Link;
procedure Picture (Output_Object : in out Corr_Output_Type;
Name : in String;
Descr : in String;
Alignment : in ARM_Output.Picture_Alignment;
Height, Width : in Natural;
Border : in ARM_Output.Border_Kind) is
-- Generate a picture.
-- Name is the (simple) file name of the picture; Descr is a
-- descriptive name for the picture (it will appear in some web
-- browsers).
-- We assume that it is a .GIF or .JPG and that it will be present
-- in the same directory as the input files and the same directory as
-- the .HTML output files.
-- Alignment specifies the picture alignment.
-- Height and Width specify the picture size in pixels.
-- Border specifies the kind of border.
begin
Ordinary_Text (Output_Object, "[Picture: " & Name &
" - " & Descr & "]");
end Picture;
end ARM_Corr;
arm_info-2020.1-src/progs/arm_corr.ads 0000664 0000000 0000000 00000050525 13734156663 0017631 0 ustar 00root root 0000000 0000000 with ARM_Output,
ARM_Contents,
Ada.Text_IO;
package ARM_Corr is
--
-- Ada reference manual formatter (ARM_Form).
--
-- This package defines the text output object.
-- Output objects are responsible for implementing the details of
-- a particular format.
--
-- ---------------------------------------
-- Copyright 2000, 2002, 2004, 2005, 2006, 2007, 2011, 2012
-- AXE Consultants. All rights reserved.
-- P.O. Box 1512, Madison WI 53701
-- E-Mail: randy@rrsoftware.com
--
-- ARM_Form is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License version 3
-- as published by the Free Software Foundation.
--
-- AXE CONSULTANTS MAKES THIS TOOL AND SOURCE CODE AVAILABLE ON AN "AS IS"
-- BASIS AND MAKES NO WARRANTY, EXPRESS OR IMPLIED, AS TO THE ACCURACY,
-- CAPABILITY, EFFICIENCY, MERCHANTABILITY, OR FUNCTIONING OF THIS TOOL.
-- IN NO EVENT WILL AXE CONSULTANTS BE LIABLE FOR ANY GENERAL,
-- CONSEQUENTIAL, INDIRECT, INCIDENTAL, EXEMPLARY, OR SPECIAL DAMAGES,
-- EVEN IF AXE CONSULTANTS HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-- DAMAGES.
--
-- A copy of the GNU General Public License is available in the file
-- gpl-3-0.txt in the standard distribution of the ARM_Form tool.
-- Otherwise, see .
--
-- If the GPLv3 license is not satisfactory for your needs, a commercial
-- use license is available for this tool. Contact Randy at AXE Consultants
-- for more information.
--
-- ---------------------------------------
--
-- Edit History:
--
-- 6/ 2/05 - RLB - Created base package from text and HTML versions.
-- 1/11/06 - RLB - Eliminated dispatching Create in favor of tailored
-- versions.
-- 1/13/06 - RLB - Added new Link operations.
-- 2/ 8/06 - RLB - Added additional parameters to the table command.
-- 2/10/06 - RLB - Added even more additional parameters to the
-- table command.
-- - RLB - Added picture command.
-- 9/25/06 - RLB - Added Last_Column_Width to Start_Table.
-- 10/13/06 - RLB - Added Local_Link_Start and Local_Link_End to allow
-- formatting in the linked text.
-- 2/ 9/07 - RLB - Changed comments on AI_Reference.
-- 2/13/07 - RLB - Revised to separate style and indent information
-- for paragraphs.
-- 12/19/07 - RLB - Added limited colors to Text_Format.
-- 10/18/11 - RLB - Changed to GPLv3 license.
-- 10/25/11 - RLB - Added old insertion version to Revised_Clause_Header.
-- 8/31/12 - RLB - Added Output_Path.
-- 11/26/12 - RLB - Added subdivision names to Clause_Header and
-- Revised_Clause_Header.
type Corr_Output_Type is new ARM_Output.Output_Type with private;
procedure Create (Output_Object : in out Corr_Output_Type;
File_Prefix : in String;
Output_Path : in String;
Title : in String := "");
-- Create an Output_Object for a document.
-- The prefix of the output file names is File_Prefix - this
-- should be no more then 5 characters allowed in file names.
-- The result files will be written to Output_Path.
-- The title of the document is Title.
procedure Close (Output_Object : in out Corr_Output_Type);
-- Close an Output_Object. No further output to the object is
-- allowed after this call.
procedure Section (Output_Object : in out Corr_Output_Type;
Section_Title : in String;
Section_Name : in String);
-- Start a new section. The title is Section_Title (this is
-- intended for humans). The name is Section_Name (this is
-- intended to be suitable to be a portion of a file name).
procedure Set_Columns (Output_Object : in out Corr_Output_Type;
Number_of_Columns : in ARM_Output.Column_Count);
-- Set the number of columns.
-- Raises Not_Valid_Error if in a paragraph.
procedure Start_Paragraph (Output_Object : in out Corr_Output_Type;
Style : in ARM_Output.Paragraph_Style_Type;
Indent : in ARM_Output.Paragraph_Indent_Type;
Number : in String;
No_Prefix : in Boolean := False;
Tab_Stops : in ARM_Output.Tab_Info := ARM_Output.NO_TABS;
No_Breaks : in Boolean := False;
Keep_with_Next : in Boolean := False;
Space_After : in ARM_Output.Space_After_Type
:= ARM_Output.Normal;
Justification : in ARM_Output.Justification_Type
:= ARM_Output.Default);
-- Start a new paragraph. The style and indent of the paragraph is as
-- specified. The (AA)RM paragraph number (which might include update
-- and version numbers as well: [12.1/1]) is Number. If the format is
-- a type with a prefix (bullets, hangining items), the prefix is
-- omitted if No_Prefix is true. Tab_Stops defines the tab stops for
-- the paragraph. If No_Breaks is True, we will try to avoid page breaks
-- in the paragraph. If Keep_with_Next is true, we will try to avoid
-- separating this paragraph and the next one. (These may have no
-- effect in formats that don't have page breaks). Space_After
-- specifies the amount of space following the paragraph. Justification
-- specifies the text justification for the paragraph. Not_Valid_Error
-- is raised if Tab_Stops /= NO_TABS for a hanging or bulleted format.
procedure End_Paragraph (Output_Object : in out Corr_Output_Type);
-- End a paragraph.
procedure Category_Header (Output_Object : in out Corr_Output_Type;
Header_Text : String);
-- Output a Category header (that is, "Legality Rules",
-- "Dynamic Semantics", etc.)
-- (Note: We did not use a enumeration here to insure that these
-- headers are spelled the same in all output versions).
-- Raises Not_Valid_Error if in a paragraph.
procedure Clause_Header (Output_Object : in out Corr_Output_Type;
Header_Text : in String;
Level : in ARM_Contents.Level_Type;
Clause_Number : in String;
Top_Level_Subdivision_Name : in ARM_Output.Top_Level_Subdivision_Name_Kind;
No_Page_Break : in Boolean := False);
-- Output a Clause header. The level of the header is specified
-- in Level. The Clause Number is as specified; the top-level (and
-- other) subdivision names are as specified. These should appear in
-- the table of contents.
-- For hyperlinked formats, this should generate a link target.
-- If No_Page_Break is True, suppress any page breaks.
-- Raises Not_Valid_Error if in a paragraph.
procedure Revised_Clause_Header
(Output_Object : in out Corr_Output_Type;
New_Header_Text : in String;
Old_Header_Text : in String;
Level : in ARM_Contents.Level_Type;
Clause_Number : in String;
Version : in ARM_Contents.Change_Version_Type;
Old_Version : in ARM_Contents.Change_Version_Type;
Top_Level_Subdivision_Name : in ARM_Output.Top_Level_Subdivision_Name_Kind;
No_Page_Break : in Boolean := False);
-- Output a revised clause header. Both the original and new text will
-- be output. The level of the header is specified in Level. The Clause
-- Number is as specified; the top-level (and other) subdivision names
-- are as specified. These should appear in the table of contents.
-- For hyperlinked formats, this should generate a link target.
-- Version is the insertion version of the new text; Old_Version is
-- the insertion version of the old text.
-- If No_Page_Break is True, suppress any page breaks.
-- Raises Not_Valid_Error if in a paragraph.
procedure TOC_Marker (Output_Object : in out Corr_Output_Type;
For_Start : in Boolean);
-- Mark the start (if For_Start is True) or end (if For_Start is
-- False) of the table of contents data. Output objects that
-- auto-generate the table of contents can use this to do needed
-- actions.
procedure New_Page (Output_Object : in out Corr_Output_Type;
Kind : ARM_Output.Page_Kind_Type := ARM_Output.Any_Page);
-- Output a page break.
-- Note that this has no effect on non-printing formats.
-- Any_Page breaks to the top of the next page (whatever it is);
-- Odd_Page_Only breaks to the top of the odd-numbered page;
-- Soft_Page allows a page break but does not force one (use in
-- "No_Breaks" paragraphs.)
-- Raises Not_Valid_Error if in a paragraph if Kind = Any_Page or
-- Odd_Page, and if not in a paragraph if Kind = Soft_Page.
procedure New_Column (Output_Object : in out Corr_Output_Type);
-- Output a column break.
-- Raises Not_Valid_Error if in a paragraph, or if the number of
-- columns is 1.
procedure Separator_Line (Output_Object : in out Corr_Output_Type;
Is_Thin : Boolean := True);
-- Output a separator line. It is thin if "Is_Thin" is true.
-- Raises Not_Valid_Error if in a paragraph.
procedure Start_Table (Output_Object : in out Corr_Output_Type;
Columns : in ARM_Output.Column_Count;
First_Column_Width : in ARM_Output.Column_Count;
Last_Column_Width : in ARM_Output.Column_Count;
Alignment : in ARM_Output.Column_Text_Alignment;
No_Page_Break : in Boolean;
Has_Border : in Boolean;
Small_Text_Size : in Boolean;
Header_Kind : in ARM_Output.Header_Kind_Type);
-- Starts a table. The number of columns is Columns; the first
-- column has First_Column_Width times the normal column width, and
-- the last column has Last_Column_Width times the normal column width.
-- Alignment is the horizontal text alignment within the columns.
-- No_Page_Break should be True to keep the table intact on a single
-- page; False to allow it to be split across pages.
-- Has_Border should be true if a border is desired, false otherwise.
-- Small_Text_Size means that the contents will have the AARM size;
-- otherwise it will have the normal size.
-- Header_Kind determines whether the table has headers.
-- This command starts a paragraph; the entire table is a single
-- paragraph. Text will be considered part of the caption until the
-- next table marker call.
-- Raises Not_Valid_Error if in a paragraph.
procedure Table_Marker (Output_Object : in out Corr_Output_Type;
Marker : in ARM_Output.Table_Marker_Type);
-- Marks the end of an entity in a table.
-- If Marker is End_Caption, the table caption ends and the
-- future text is part of the table header.
-- If Marker is End_Header, the table header ends and the
-- future text is part of the table body.
-- If Marker is End_Row, a row in the table is completed, and another
-- row started.
-- If Marker is End_Item, an item in the table header or body is ended,
-- and another started.
-- If Marker is End_Table, the entire table is finished.
-- Raises Not_Valid_Error if not in a table.
-- Text output: These are only allowed after a Start_Paragraph and
-- before any End_Paragraph. Raises Not_Valid_Error if not allowed.
procedure Ordinary_Text (Output_Object : in out Corr_Output_Type;
Text : in String);
-- Output ordinary text.
-- The text must end at a word break, never in the middle of a word.
procedure Ordinary_Character (Output_Object : in out Corr_Output_Type;
Char : in Character);
-- Output an ordinary character.
-- Spaces will be used to break lines as needed.
procedure Hard_Space (Output_Object : in out Corr_Output_Type);
-- Output a hard space. No line break should happen at a hard space.
procedure Line_Break (Output_Object : in out Corr_Output_Type);
-- Output a line break. This does not start a new paragraph.
-- This corresponds to a "
" in HTML.
procedure Index_Line_Break (Output_Object : in out Corr_Output_Type;
Clear_Keep_with_Next : in Boolean);
-- Output a line break for the index. This does not start a new
-- paragraph in terms of spacing. This corresponds to a "
"
-- in HTML. If Clear_Keep_with_Next is true, insure that the next
-- line does not require the following line to stay with it.
procedure Soft_Line_Break (Output_Object : in out Corr_Output_Type);
-- Output a soft line break. This is a place (in the middle of a
-- "word") that we allow a line break. It is usually used after
-- underscores in long non-terminals.
procedure Soft_Hyphen_Break (Output_Object : in out Corr_Output_Type);
-- Output a soft line break, with a hyphen. This is a place (in the middle of
-- a "word") that we allow a line break. If the line break is used,
-- a hyphen will be added to the text.
procedure Tab (Output_Object : in out Corr_Output_Type);
-- Output a tab, inserting space up to the next tab stop.
-- Raises Not_Valid_Error if the paragraph was created with
-- Tab_Stops = ARM_Output.NO_TABS.
procedure Special_Character (Output_Object : in out Corr_Output_Type;
Char : in ARM_Output.Special_Character_Type);
-- Output an special character.
procedure Unicode_Character (Output_Object : in out Corr_Output_Type;
Char : in ARM_Output.Unicode_Type);
-- Output a Unicode character, with code position Char.
procedure End_Hang_Item (Output_Object : in out Corr_Output_Type);
-- Marks the end of a hanging item. Call only once per paragraph.
-- Raises Not_Valid_Error if the paragraph style is not in
-- Text_Prefixed_Style_Subtype, or if this has already been
-- called for the current paragraph, or if the paragraph was started
-- with No_Prefix = True.
procedure Text_Format (Output_Object : in out Corr_Output_Type;
Format : in ARM_Output.Format_Type);
-- Change the text format so that all of the properties are as specified.
-- Note: Changes to these properties ought be stack-like; that is,
-- Bold on, Italic on, Italic off, Bold off is OK; Bold on, Italic on,
-- Bold off, Italic off should be avoided (as separate commands).
procedure Clause_Reference (Output_Object : in out Corr_Output_Type;
Text : in String;
Clause_Number : in String);
-- Generate a reference to a clause in the standard. The text of
-- the reference is "Text", and the number of the clause is
-- Clause_Number. For hyperlinked formats, this should generate
-- a link; for other formats, the text alone is generated.
procedure Index_Target (Output_Object : in out Corr_Output_Type;
Index_Key : in Natural);
-- Generate a index target. This marks the location where an index
-- reference occurs. Index_Key names the index item involved.
-- For hyperlinked formats, this should generate a link target;
-- for other formats, nothing is generated.
procedure Index_Reference (Output_Object : in out Corr_Output_Type;
Text : in String;
Index_Key : in Natural;
Clause_Number : in String);
-- Generate a reference to an index target in the standard. The text
-- of the reference is "Text", and Index_Key and Clause_Number denotes
-- the target. For hyperlinked formats, this should generate
-- a link; for other formats, the text alone is generated.
procedure DR_Reference (Output_Object : in out Corr_Output_Type;
Text : in String;
DR_Number : in String);
-- Generate a reference to an DR from the standard. The text
-- of the reference is "Text", and DR_Number denotes
-- the target. For hyperlinked formats, this should generate
-- a link; for other formats, the text alone is generated.
procedure AI_Reference (Output_Object : in out Corr_Output_Type;
Text : in String;
AI_Number : in String);
-- Generate a reference to an AI from the standard. The text
-- of the reference is "Text", and AI_Number denotes
-- the target (in unfolded format). For hyperlinked formats, this should
-- generate a link; for other formats, the text alone is generated.
procedure Local_Target (Output_Object : in out Corr_Output_Type;
Text : in String;
Target : in String);
-- Generate a local target. This marks the potential target of local
-- links identified by "Target". Text is the text of the target.
-- For hyperlinked formats, this should generate a link target;
-- for other formats, only the text is generated.
procedure Local_Link (Output_Object : in out Corr_Output_Type;
Text : in String;
Target : in String;
Clause_Number : in String);
-- Generate a local link to the target and clause given.
-- Text is the text of the link.
-- For hyperlinked formats, this should generate a link;
-- for other formats, only the text is generated.
procedure Local_Link_Start (Output_Object : in out Corr_Output_Type;
Target : in String;
Clause_Number : in String);
-- Generate a local link to the target and clause given.
-- The link will surround text until Local_Link_End is called.
-- Local_Link_End must be called before this routine can be used again.
-- For hyperlinked formats, this should generate a link;
-- for other formats, only the text is generated.
procedure Local_Link_End (Output_Object : in out Corr_Output_Type;
Target : in String;
Clause_Number : in String);
-- End a local link for the target and clause given.
-- This must be in the same paragraph as the Local_Link_Start.
-- For hyperlinked formats, this should generate a link;
-- for other formats, only the text is generated.
procedure URL_Link (Output_Object : in out Corr_Output_Type;
Text : in String;
URL : in String);
-- Generate a link to the URL given.
-- Text is the text of the link.
-- For hyperlinked formats, this should generate a link;
-- for other formats, only the text is generated.
procedure Picture (Output_Object : in out Corr_Output_Type;
Name : in String;
Descr : in String;
Alignment : in ARM_Output.Picture_Alignment;
Height, Width : in Natural;
Border : in ARM_Output.Border_Kind);
-- Generate a picture.
-- Name is the (simple) file name of the picture; Descr is a
-- descriptive name for the picture (it will appear in some web
-- browsers).
-- We assume that it is a .GIF or .JPG and that it will be present
-- in the same directory as the output files.
-- Alignment specifies the picture alignment.
-- Height and Width specify the picture size in pixels.
-- Border specifies the kind of border.
private
subtype Buffer_String is String (1 .. 120);
subtype Prefix_String is String(1..5);
subtype Clause_String is String(1..20);
type Corr_Output_Type is new ARM_Output.Output_Type with record
Is_Valid : Boolean := False;
Is_In_Paragraph : Boolean := False;
Is_In_Table : Boolean := False; -- Are we processing a table?
Is_Hanging : Boolean := False; -- If we are in a paragraph,
-- is it a hanging paragraph?
Saw_Hang_End : Boolean := False; -- If we are in a hanging paragraph,
-- have we seen the end of the hanging part yet?
Output_Buffer : Buffer_String; -- Output buffer to make smarter breaks.
Output_Buffer_Len : Natural := 0; -- This should be empty between paragraphs.
-- The idea is that the buffer is always logically
-- preceeded by a space. Thus it is always OK to
-- move the text in the buffer to the next line.
Output_Buffer_Space_Before : Boolean := False;
-- Do we need to output a space before the buffer?
Output_File : Ada.Text_IO.File_Type;
Output_Path : Buffer_String;
Output_Path_Len : Natural := 0;
File_Prefix : Prefix_String; -- Blank padded.
Char_Count : Natural := 0; -- Characters on current line.
Out_Char_Count : Natural := 0; -- Characters output on current line.
Indent_Amount : Natural := 0; -- Amount to indent paragraphs.
Para_Style : ARM_Output.Paragraph_Style_Type := ARM_Output.Normal;
Para_Indent : ARM_Output.Paragraph_Indent_Type := 0; -- Specified indent.
Is_Fixed_Format : Boolean; -- Is the text currently in a fixed format? (@Xcode)
Is_Bold : Boolean; -- Is the text currently bold?
Is_Italic : Boolean; -- Is the text current italics?
Font : ARM_Output.Font_Family_Type; -- What is the current font family?
Size : ARM_Output.Size_Type; -- What is the current relative size?
Change : ARM_Output.Change_Type := ARM_Output.None;
Location : ARM_Output.Location_Type := ARM_Output.Normal;
Tab_Stops : ARM_Output.Tab_Info := ARM_Output.NO_TABS;
Clause_Num : Clause_String; -- The number of the current clause
Clause_Len : Natural := 0;
end record;
end ARM_Corr;
arm_info-2020.1-src/progs/arm_db.adb 0000664 0000000 0000000 00000031260 13734156663 0017223 0 ustar 00root root 0000000 0000000 -- with Ada.Text_IO; -- Debug.
with Ada.Unchecked_Deallocation,
Ada.Strings.Fixed,
Ada.Characters.Handling;
package body ARM_Database is
--
-- Ada reference manual formatter (ARM_Form).
--
-- This package contains the database to store items for non-normative
-- appendixes.
--
-- ---------------------------------------
-- Copyright 2000, 2004, 2005, 2006, 2009, 2011, 2012, 2019
-- AXE Consultants. All rights reserved.
-- P.O. Box 1512, Madison WI 53701
-- E-Mail: randy@rrsoftware.com
--
-- ARM_Form is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License version 3
-- as published by the Free Software Foundation.
--
-- AXE CONSULTANTS MAKES THIS TOOL AND SOURCE CODE AVAILABLE ON AN "AS IS"
-- BASIS AND MAKES NO WARRANTY, EXPRESS OR IMPLIED, AS TO THE ACCURACY,
-- CAPABILITY, EFFICIENCY, MERCHANTABILITY, OR FUNCTIONING OF THIS TOOL.
-- IN NO EVENT WILL AXE CONSULTANTS BE LIABLE FOR ANY GENERAL,
-- CONSEQUENTIAL, INDIRECT, INCIDENTAL, EXEMPLARY, OR SPECIAL DAMAGES,
-- EVEN IF AXE CONSULTANTS HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-- DAMAGES.
--
-- A copy of the GNU General Public License is available in the file
-- gpl-3-0.txt in the standard distribution of the ARM_Form tool.
-- Otherwise, see .
--
-- If the GPLv3 license is not satisfactory for your needs, a commercial
-- use license is available for this tool. Contact Randy at AXE Consultants
-- for more information.
--
-- ---------------------------------------
--
-- Edit History:
--
-- 5/16/00 - RLB - Created package.
-- 8/28/00 - RLB - Added revision info to database.
-- 10/28/04 - RLB - Added Inserted_Normal_Number change kind.
-- 11/02/04 - RLB - Added Deleted_Inserted_Number change kind.
-- 12/06/04 - RLB - Added Revised_Inserted_Number change kind.
-- 12/14/04 - RLB - Made the hang item bigger.
-- 1/19/05 - RLB - Added Added_Version.
-- 10/17/05 - RLB - Fixed indexing of the Glossary.
-- 10/18/06 - RLB - Added No_Deleted_Paragraph_Messages to Report.
-- 11/30/09 - RLB - Made the hang item bigger again (to make room to
-- handle commands like @ChgAdded).
-- 10/18/11 - RLB - Changed to GPLv3 license.
-- 10/20/11 - RLB - Added Initial_Version parameter.
-- 3/19/12 - RLB - Added code to suppress indexing of deleted glossary items.
-- 1/27/19 - RLB - Lengthened components to allow Reduce attributes.
type String_Ptr is access String;
type Item is record
Next : Item_List;
Sort_Key : String(1 .. 55);
Hang : String(1 .. 85);
Hang_Len : Natural;
Text : String_Ptr;
Change_Kind : Paragraph_Change_Kind_Type;
Version : Character;
Initial_Version : Character;
end record;
procedure Free is new Ada.Unchecked_Deallocation (Item, Item_List);
procedure Free is new Ada.Unchecked_Deallocation (String, String_Ptr);
procedure Create (Database_Object : in out Database_Type) is
-- Initialize a database object.
begin
Database_Object.Is_Valid := True;
Database_Object.List := null;
Database_Object.Item_Count := 0;
end Create;
procedure Destroy (Database_Object : in out Database_Type) is
-- Destroy a database object, freeing any resources used.
Temp : Item_List;
begin
if not Database_Object.Is_Valid then
raise Not_Valid_Error;
end if;
while Database_Object.List /= null loop
Temp := Database_Object.List;
Database_Object.List := Temp.Next;
Free (Temp.Text);
Free (Temp);
end loop;
Database_Object.Is_Valid := False;
end Destroy;
procedure Insert (Database_Object : in out Database_Type;
Sort_Key : in String;
Hang_Item : in String;
Text : in String;
Change_Kind : in Paragraph_Change_Kind_Type := ARM_Database.None;
Version : in Character := '0';
Initial_Version : in Character := '0') is
-- Insert an item into the database object.
-- Sort_Key is the string on which this item will be sorted (if it
-- is sorted). Hang_Item is the item which hangs out for the item
-- in the report (if any). Text is the text for the item; the text
-- may include formatting codes. Change_Kind and Version are the
-- revision status for this item. Initial_Version is the version of
-- the initial text for this item.
Temp_Item : Item;
begin
if not Database_Object.Is_Valid then
raise Not_Valid_Error;
end if;
--if Sort_Key'Length > Temp_Item.Sort_Key'Length - 10 then
-- Ada.Text_IO.Put_Line ("?? Sort_Key near or beyond size limit; Length=" &
-- Natural'Image(Sort_Key'Length) & "; Limit=" &
-- Natural'Image(Temp_Item.Sort_Key'Length) & "; Sort_Key=" & Sort_Key);
--end if;
--if Hang_Item'Length > Temp_Item.Hang'Length - 10 then
-- Ada.Text_IO.Put_Line ("?? Hang_Item near or beyond size limit; Length=" &
-- Natural'Image(Hang_Item'Length) & "; Limit=" &
-- Natural'Image(Temp_Item.Hang'Length) & "; Hang_Item=" & Hang_Item);
--end if;
Ada.Strings.Fixed.Move (Target => Temp_Item.Sort_Key,
Source => Ada.Characters.Handling.To_Lower(Sort_Key),
Drop => Ada.Strings.Right,
Pad => ' ');
Ada.Strings.Fixed.Move (Target => Temp_Item.Hang,
Source => Hang_Item,
Drop => Ada.Strings.Error,
Pad => ' ');
Temp_Item.Hang_Len := Hang_Item'Length;
-- Note: If this second item doesn't fit, we error so we can make
-- the size larger.
Temp_Item.Text := new String'(Text);
Temp_Item.Change_Kind := Change_Kind;
Temp_Item.Version := Version;
Temp_Item.Initial_Version := Initial_Version;
Temp_Item.Next := Database_Object.List;
Database_Object.List := new Item'(Temp_Item);
Database_Object.Item_Count := Database_Object.Item_Count + 1;
end Insert;
--generic
-- with procedure Format_Text (Text : in String;
-- Text_Name : in String);
procedure Report (Database_Object : in out Database_Type;
In_Format : in Format_Type;
Sorted : in Boolean;
Added_Version : Character := '0';
No_Deleted_Paragraph_Messages : in Boolean := False) is
-- Output the items with the appropriate format to the
-- "Format_Text" routine. "Format_Text" allows all commands
-- for the full formatter. (Text_Name is an identifying name
-- for error messages). This is an added list for Added_Version
-- ('0' meaning it is not added); in that case, use normal numbers
-- for items with a version less than or equal to Added_Version.
-- (This is intended to be used to output the items to
-- appropriate Format and Output objects; but we can't do that
-- directly because that would make this unit recursive with
-- ARM_Format.
-- No paragraphs will be have deleted paragraph messages if
-- No_Deleted_Paragraph_Messages is True.
Temp : Item_List;
function Change_if_Needed (Item : in Item_List) return String is
begin
-- Note: In the report, we always decide inserted/not inserted
-- as determined by the initial version number, and not the
-- original class.
case Item.Change_Kind is
when None => return "";
when Inserted | Inserted_Normal_Number =>
if Item.Initial_Version <= Added_Version then
return "@ChgRef{Version=[" & Item.Version &
"],Kind=[AddedNormal]}";
else
return "@ChgRef{Version=[" & Item.Version &
"],Kind=[Added]}";
end if;
when Revised | Revised_Inserted_Number =>
if Item.Initial_Version <= Added_Version then
return "@ChgRef{Version=[" & Item.Version &
"],Kind=[Revised]}";
else
return "@ChgRef{Version=[" & Item.Version &
"],Kind=[RevisedAdded]}";
end if;
when Deleted | Deleted_Inserted_Number =>
if Item.Initial_Version <= Added_Version then
if No_Deleted_Paragraph_Messages then
return "@ChgRef{Version=[" & Item.Version &
"],Kind=[DeletedNoDelMsg]}";
else
return "@ChgRef{Version=[" & Item.Version &
"],Kind=[Deleted]}";
end if;
else
if No_Deleted_Paragraph_Messages then
return "@ChgRef{Version=[" & Item.Version &
"],Kind=[DeletedAddedNoDelMsg]}";
else
return "@ChgRef{Version=[" & Item.Version &
"],Kind=[DeletedAdded]}";
end if;
end if;
when Deleted_No_Delete_Message |
Deleted_Inserted_Number_No_Delete_Message =>
if Item.Initial_Version <= Added_Version then
return "@ChgRef{Version=[" & Item.Version &
"],Kind=[DeletedNoDelMsg]}";
else
return "@ChgRef{Version=[" & Item.Version &
"],Kind=[DeletedAddedNoDelMsg]}";
end if;
end case;
end Change_if_Needed;
begin
if not Database_Object.Is_Valid then
raise Not_Valid_Error;
end if;
if Sorted then
declare
Items : array (1..Database_Object.Item_Count) of Item_List;
begin
-- Load the items:
Temp := Database_Object.List;
for I in Items'range loop
Items(I) := Temp;
Temp := Temp.Next;
end loop;
-- Sort the items array (use an insertion sort because it is
-- stable):
declare
Left : Natural; -- Left sorting stop
begin
for Right In Items'First+1 .. Items'Last loop -- Right sorting stop
Temp := Items(Right);
Left := Right - 1;
while Temp.Sort_Key <= Items(Left).Sort_Key loop -- Switch items
Items(Left + 1) := Items(Left);
Left := Left - 1;
exit when Left = 0;
end loop;
Items(Left + 1) := Temp;
end loop;
end;
-- Relink the items in the sorted order:
for I in Items'First .. Items'Last - 1 loop
Items(I).Next := Items(I+1);
end loop;
if Items'Length > 0 then
Items(Items'Last).Next := null;
Database_Object.List := Items(1);
else
Database_Object.List := null;
end if;
end;
end if;
case In_Format is
when Hanging_List =>
Format_Text ("@begin(description)" & Ascii.LF, "Prefix");
Temp := Database_Object.List;
while Temp /= null loop
--** Debug:
--Ada.Text_IO.Put_Line ("^^ " & Paragraph_Change_Kind_Type'Image(Temp.Change_Kind) &
-- " for " & Temp.Hang(1..Temp.Hang_Len) & " ref=" & Change_if_Needed (Temp));
--Ada.Text_IO.Put_Line (" " & Change_if_Needed (Temp) &
--Temp.Hang(1..Temp.Hang_Len) & "@\" &
--Temp.Text.all & Ascii.LF & Ascii.LF);
Format_Text (Change_if_Needed (Temp) &
Temp.Hang(1..Temp.Hang_Len) & "@\" &
Temp.Text.all & Ascii.LF & Ascii.LF, Temp.Sort_Key);
Temp := Temp.Next;
end loop;
Format_Text ("@end(description)" & Ascii.LF, "Suffix");
when Bullet_List =>
Format_Text ("@begin(itemize)" & Ascii.LF, "Prefix");
Temp := Database_Object.List;
while Temp /= null loop
Format_Text (Change_if_Needed (Temp) &
Temp.Text.all & Ascii.LF & Ascii.LF, Temp.Sort_Key);
Temp := Temp.Next;
end loop;
Format_Text ("@end(itemize)" & Ascii.LF, "Suffix");
when Normal_List =>
Format_Text ("@begin(intro)" & Ascii.LF, "Prefix");
Temp := Database_Object.List;
while Temp /= null loop
Format_Text (Change_if_Needed (Temp) &
Temp.Text.all & Ascii.LF & Ascii.LF, Temp.Sort_Key);
Temp := Temp.Next;
end loop;
Format_Text ("@end(intro)" & Ascii.LF, "Suffix");
when Normal_Indexed_List =>
Format_Text ("@begin(intro)" & Ascii.LF, "Prefix");
Temp := Database_Object.List;
while Temp /= null loop
case Temp.Change_Kind is
when None |
Inserted | Inserted_Normal_Number |
Revised | Revised_Inserted_Number =>
--** Debug:
--Ada.Text_IO.Put_Line("Format " & Change_if_Needed (Temp) &
-- "@defn{" & Ada.Strings.Fixed.Trim (Temp.Sort_Key, Ada.Strings.Right) & "}" & Ascii.LF &
-- Temp.Text.all);
-- Index this item.
Format_Text (Change_if_Needed (Temp) &
"@defn{" & Ada.Strings.Fixed.Trim (Temp.Sort_Key, Ada.Strings.Right) & "}" & Ascii.LF &
Temp.Text.all & Ascii.LF & Ascii.LF, Temp.Sort_Key);
when Deleted | Deleted_Inserted_Number |
Deleted_No_Delete_Message |
Deleted_Inserted_Number_No_Delete_Message =>
--** Debug:
--Ada.Text_IO.Put_Line("Format " & Change_if_Needed (Temp) & Ascii.LF &
-- Temp.Text.all);
-- Don't index deleted items.
Format_Text (Change_if_Needed (Temp) & Ascii.LF &
Temp.Text.all & Ascii.LF & Ascii.LF, Temp.Sort_Key);
end case;
Temp := Temp.Next;
end loop;
Format_Text ("@end(intro)" & Ascii.LF, "Suffix");
end case;
end Report;
end ARM_Database;
arm_info-2020.1-src/progs/arm_db.ads 0000664 0000000 0000000 00000011563 13734156663 0017250 0 ustar 00root root 0000000 0000000 package ARM_Database is
--
-- Ada reference manual formatter (ARM_Form).
--
-- This package contains the database to store items for non-normative
-- appendixes.
--
-- ---------------------------------------
-- Copyright 2000, 2004, 2005, 2006, 2011
-- AXE Consultants. All rights reserved.
-- P.O. Box 1512, Madison WI 53701
-- E-Mail: randy@rrsoftware.com
--
-- ARM_Form is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License version 3
-- as published by the Free Software Foundation.
--
-- AXE CONSULTANTS MAKES THIS TOOL AND SOURCE CODE AVAILABLE ON AN "AS IS"
-- BASIS AND MAKES NO WARRANTY, EXPRESS OR IMPLIED, AS TO THE ACCURACY,
-- CAPABILITY, EFFICIENCY, MERCHANTABILITY, OR FUNCTIONING OF THIS TOOL.
-- IN NO EVENT WILL AXE CONSULTANTS BE LIABLE FOR ANY GENERAL,
-- CONSEQUENTIAL, INDIRECT, INCIDENTAL, EXEMPLARY, OR SPECIAL DAMAGES,
-- EVEN IF AXE CONSULTANTS HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-- DAMAGES.
--
-- A copy of the GNU General Public License is available in the file
-- gpl-3-0.txt in the standard distribution of the ARM_Form tool.
-- Otherwise, see .
--
-- If the GPLv3 license is not satisfactory for your needs, a commercial
-- use license is available for this tool. Contact Randy at AXE Consultants
-- for more information.
--
-- ---------------------------------------
--
-- Edit History:
--
-- 5/16/00 - RLB - Created package.
-- 8/10/00 - RLB - Added Normal_Indexed_List to fix glossary problems.
-- 8/28/00 - RLB - Added revision info to database.
-- 10/28/04 - RLB - Added Inserted_Normal_Number change kind.
-- 11/02/04 - RLB - Added Deleted_Inserted_Number change kind.
-- 12/06/04 - RLB - Added Revised_Inserted_Number change kind.
-- 1/19/05 - RLB - Added Added_Version.
-- 2/15/06 - RLB - Added Deleted_No_Delete_Message and
-- Deleted_Inserted_Number_No_Delete_Message change kinds.
-- 10/18/06 - RLB - Added No_Deleted_Paragraph_Messages to Report.
-- 10/18/11 - RLB - Changed to GPLv3 license.
-- 10/20/11 - RLB - Added Initial_Version parameter.
type Database_Type is tagged limited private;
type Paragraph_Change_Kind_Type is (None, Inserted, Inserted_Normal_Number,
Deleted, Deleted_Inserted_Number,
Deleted_No_Delete_Message,
Deleted_Inserted_Number_No_Delete_Message,
Revised, Revised_Inserted_Number);
Not_Valid_Error : exception;
procedure Create (Database_Object : in out Database_Type);
-- Initialize a database object.
procedure Destroy (Database_Object : in out Database_Type);
-- Destroy a database object, freeing any resources used.
procedure Insert (Database_Object : in out Database_Type;
Sort_Key : in String;
Hang_Item : in String;
Text : in String;
Change_Kind : in Paragraph_Change_Kind_Type := ARM_Database.None;
Version : in Character := '0';
Initial_Version : in Character := '0');
-- Insert an item into the database object.
-- Sort_Key is the string on which this item will be sorted (if it
-- is sorted). Hang_Item is the item which hangs out for the item
-- in the report (if any). Text is the text for the item; the text
-- may include formatting codes. Change_Kind and Version are the
-- revision status for this item. Initial_Version is the version of
-- the initial text for this item.
type Format_Type is
(Normal_List, Normal_Indexed_List, Bullet_List, Hanging_List);
generic
with procedure Format_Text (Text : in String;
Text_Name : in String);
procedure Report (Database_Object : in out Database_Type;
In_Format : in Format_Type;
Sorted : in Boolean;
Added_Version : Character := '0';
No_Deleted_Paragraph_Messages : in Boolean := False);
-- Output the items with the appropriate format to the
-- "Format_Text" routine. "Format_Text" allows all commands
-- for the full formatter. (Text_Name is an identifying name
-- for error messages). This is an added list for Added_Version
-- ('0' meaning it is not added); in that case, use normal numbers
-- for items with a version less than or equal to Added_Version.
-- (This is intended to be used to output the items to
-- appropriate Format and Output objects; but we can't do that
-- directly because that would make this unit recursive with
-- ARM_Format.
-- No paragraphs will be have deleted paragraph messages if
-- No_Deleted_Paragraph_Messages is True.
private
type Item;
type Item_List is access all Item;
type Database_Type is tagged limited record
Is_Valid : Boolean := False;
List : Item_List;
Item_Count : Natural;
end record;
end ARM_Database;
arm_info-2020.1-src/progs/arm_file.adb 0000664 0000000 0000000 00000021141 13734156663 0017552 0 ustar 00root root 0000000 0000000 --with ARM_Input,
-- Ada.Text_IO;
package body ARM_File is
--
-- Ada reference manual formatter (ARM_Form).
--
-- This package contains the definition of reading an input file.
--
-- ---------------------------------------
-- Copyright 2000, 2011, 2019
-- AXE Consultants. All rights reserved.
-- P.O. Box 1512, Madison WI 53704
-- E-Mail: randy@rrsoftware.com
--
-- ARM_Form is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License version 3
-- as published by the Free Software Foundation.
--
-- AXE CONSULTANTS MAKES THIS TOOL AND SOURCE CODE AVAILABLE ON AN "AS IS"
-- BASIS AND MAKES NO WARRANTY, EXPRESS OR IMPLIED, AS TO THE ACCURACY,
-- CAPABILITY, EFFICIENCY, MERCHANTABILITY, OR FUNCTIONING OF THIS TOOL.
-- IN NO EVENT WILL AXE CONSULTANTS BE LIABLE FOR ANY GENERAL,
-- CONSEQUENTIAL, INDIRECT, INCIDENTAL, EXEMPLARY, OR SPECIAL DAMAGES,
-- EVEN IF AXE CONSULTANTS HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-- DAMAGES.
--
-- A copy of the GNU General Public License is available in the file
-- gpl-3-0.txt in the standard distribution of the ARM_Form tool.
-- Otherwise, see .
--
-- If the GPLv3 license is not satisfactory for your needs, a commercial
-- use license is available for this tool. Contact Randy at AXE Consultants
-- for more information.
--
-- ---------------------------------------
--
-- Edit History:
--
-- 5/15/00 - RLB - Created package.
-- 10/18/11 - RLB - Changed to GPLv3 license.
-- 2/15/19 - RLB - Improved error handling of recording buffer overflow.
-- 2/19/19 - RLB - Added replacement of previous line end.
procedure Open (Input_Object : in out File_Input_Type;
File_Name : in String) is
-- Open an input object for a file.
-- This may propagate file exceptions.
begin
Ada.Text_IO.Open (Input_Object.Fyle, Ada.Text_IO.In_File, File_Name);
Input_Object.Line_Counter := 0;
Input_Object.Buffer_Last := 0;
Input_Object.Buffer_Index := 0;
Input_Object.Extra_LF := False;
Input_Object.Is_Valid := True;
if File_Name'Length > Input_Object.Name'Length then
Input_Object.Name := File_Name(File_Name'First .. File_Name'First + Input_Object.Name'Length - 1);
Input_Object.Name_Len := Input_Object.Name'Length;
else
Input_Object.Name(1..File_Name'Length) := File_Name;
Input_Object.Name_Len := File_Name'Length;
end if;
end Open;
procedure Close (Input_Object : in out File_Input_Type) is
-- Close the input object (entity).
-- May propagate exceptions from the underlying implementation
-- (that is, I/O exceptions).
begin
if not Input_Object.Is_Valid then
raise ARM_Input.Not_Valid_Error;
end if;
Input_Object.Is_Valid := False;
Ada.Text_IO.Close (Input_Object.Fyle);
end Close;
procedure Get_Char (Input_Object : in out File_Input_Type;
Char : out Character) is
-- We represent end of line by Ascii.LF.
-- Raises: End_Error when the end of file is reached.
-- Not_Valid_Error if Input_Object is not valid (open).
begin
if not Input_Object.Is_Valid then
raise ARM_Input.Not_Valid_Error with "No file open";
end if;
if Input_Object.Extra_LF then
-- A special put-back of the previous line. We don't adjust
-- the line counter for this character, and it is already
-- in the recording buffer if necessary.
Char := Ascii.LF;
Input_Object.Extra_LF := False;
return;
elsif Input_Object.Buffer_Index >= Input_Object.Buffer_Last then
begin
Ada.Text_IO.Get_Line (Input_Object.Fyle,
Input_Object.Buffer,
Input_Object.Buffer_Last);
-- Raises End_Error when the end of the file is reached.
exception
when Ada.Text_IO.End_Error =>
-- Set so we can do a Replace_Char on this.
Input_Object.Buffer_Index := 1;
Input_Object.Buffer_Last := 1;
Input_Object.Buffer(1) := Ascii.SUB; -- File end marker.
Char := Ascii.SUB;
return;
end;
if Input_Object.Buffer_Last < Input_Object.Buffer'Last then
Input_Object.Buffer_Last := Input_Object.Buffer_Last + 1;
Input_Object.Buffer(Input_Object.Buffer_Last) := Ascii.LF; -- Line end marker.
-- else broken line, no end needed.
end if;
--Ada.Text_IO.Put(Natural'Image(Input_Object.Line_Counter) & ":");
--Ada.Text_IO.Put_Line ("&& " & Input_Object.Buffer(1..Input_Object.Buffer_Last));
Input_Object.Buffer_Index := 0;
Input_Object.Line_Counter := Input_Object.Line_Counter + 1;
end if;
Input_Object.Buffer_Index := Input_Object.Buffer_Index + 1;
if Input_Object.Recording then
Input_Object.Recording_Len := Input_Object.Recording_Len + 1;
if Input_Object.Recording_Len > Input_Object.Recording_Buffer'Last then
Ada.Text_IO.Put_Line (" ** Too many characters recorded on line " & Line_String (Input_Object));
Ada.Text_IO.Put_Line (" Recording started on line" & Natural'Image(Input_Object.Recording_Start_Line));
Input_Object.Recording_Len := Input_Object.Recording_Buffer'Last;
Input_Object.Recording := False;
else
Input_Object.Recording_Buffer(Input_Object.Recording_Len) :=
Input_Object.Buffer(Input_Object.Buffer_Index);
end if;
end if;
Char := Input_Object.Buffer(Input_Object.Buffer_Index);
end Get_Char;
procedure Replace_Char (Input_Object : in out File_Input_Type) is
-- Replaces the last character read (with Get_Char); the next call
-- to Get_Char will return it.
-- Raises: Not_Valid_Error if Input_Object is not valid (open).
begin
if not Input_Object.Is_Valid then
raise ARM_Input.Not_Valid_Error with "No file open";
end if;
if Input_Object.Buffer_Index = 0 then
if Input_Object.Extra_LF then -- Extra put back already done.
raise Program_Error with "Replace_Char called too many times";
else
Input_Object.Extra_LF := True;
-- We don't adjust the buffer or the recording in this case.
return;
end if;
end if;
Input_Object.Buffer_Index := Input_Object.Buffer_Index - 1;
if Input_Object.Recording then
Input_Object.Recording_Len := Input_Object.Recording_Len - 1;
end if;
end Replace_Char;
function Line_String (Input_Object : in File_Input_Type) return String is
-- Returns a string representing the line number and entity.
-- Usually used in error messages.
-- Raises: Not_Valid_Error if Input_Object is not valid (open).
begin
if not Input_Object.Is_Valid then
raise ARM_Input.Not_Valid_Error;
end if;
return Natural'Image(Input_Object.Line_Counter) & " - " &
Input_Object.Name(1..Input_Object.Name_Len);
end Line_String;
procedure Start_Recording (Input_Object : in out File_Input_Type) is
-- Start recording all characters read into a local buffer.
-- Use this when text needs to be formatted into the output
-- file *and* be saved for future use.
-- Raises: Not_Valid_Error if Input_Object is not valid (open).
begin
if not Input_Object.Is_Valid then
raise ARM_Input.Not_Valid_Error;
end if;
Input_Object.Recording := True;
Input_Object.Recording_Len := 0;
Input_Object.Recording_Start_Line := Input_Object.Line_Counter;
end Start_Recording;
procedure Stop_Recording_and_Read_Result
(Input_Object : in out File_Input_Type; Result : out String;
Len : out Natural) is
-- Stop recording characters read. Put the result into Result,
-- and the number of characters written into Len.
-- Raises: Not_Valid_Error if Input_Object is not valid (open).
begin
if not Input_Object.Is_Valid then
raise ARM_Input.Not_Valid_Error;
end if;
if Input_Object.Recording_Len > Result'Length then
Ada.Text_IO.Put_Line (" ** Too many characters recorded on line " & Line_String (Input_Object));
Ada.Text_IO.Put_Line (" Recording started on line" & Natural'Image(Input_Object.Recording_Start_Line));
Len := 0;
else
Result (Result'First .. Result'First + Input_Object.Recording_Len - 1) :=
Input_Object.Recording_Buffer (1 .. Input_Object.Recording_Len);
Len := Input_Object.Recording_Len;
end if;
Input_Object.Recording := False;
end Stop_Recording_and_Read_Result;
end ARM_File;
arm_info-2020.1-src/progs/arm_file.ads 0000664 0000000 0000000 00000010407 13734156663 0017576 0 ustar 00root root 0000000 0000000 with ARM_Input,
Ada.Text_IO;
package ARM_File is
--
-- Ada reference manual formatter (ARM_Form).
--
-- This package contains the definition of reading an input file.
--
-- ---------------------------------------
-- Copyright 2000, 2011, 2019
-- AXE Consultants. All rights reserved.
-- P.O. Box 1512, Madison WI 53704
-- E-Mail: randy@rrsoftware.com
--
-- ARM_Form is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License version 3
-- as published by the Free Software Foundation.
--
-- AXE CONSULTANTS MAKES THIS TOOL AND SOURCE CODE AVAILABLE ON AN "AS IS"
-- BASIS AND MAKES NO WARRANTY, EXPRESS OR IMPLIED, AS TO THE ACCURACY,
-- CAPABILITY, EFFICIENCY, MERCHANTABILITY, OR FUNCTIONING OF THIS TOOL.
-- IN NO EVENT WILL AXE CONSULTANTS BE LIABLE FOR ANY GENERAL,
-- CONSEQUENTIAL, INDIRECT, INCIDENTAL, EXEMPLARY, OR SPECIAL DAMAGES,
-- EVEN IF AXE CONSULTANTS HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-- DAMAGES.
--
-- A copy of the GNU General Public License is available in the file
-- gpl-3-0.txt in the standard distribution of the ARM_Form tool.
-- Otherwise, see .
--
-- If the GPLv3 license is not satisfactory for your needs, a commercial
-- use license is available for this tool. Contact Randy at AXE Consultants
-- for more information.
--
-- ---------------------------------------
--
-- Edit History:
--
-- 5/15/00 - RLB - Created package.
-- 10/18/11 - RLB - Changed to GPLv3 license.
-- 2/15/19 - RLB - Added Recording_Start_Line to help debugging.
-- 2/19/19 - RLB - Added Extra_LF so we can put back the line end of
-- the previous line.
type File_Input_Type is new ARM_Input.Input_Type with private;
procedure Open (Input_Object : in out File_Input_Type;
File_Name : in String);
-- Open an input object for a file.
-- This may propagate file exceptions.
procedure Close (Input_Object : in out File_Input_Type);
-- Close the input object (entity).
-- May propagate exceptions from the underlying implementation
-- (that is, I/O exceptions).
procedure Get_Char (Input_Object : in out File_Input_Type;
Char : out Character);
-- We represent end of line by Ascii.LF.
-- Raises: End_Error when the end of file is reached.
-- Not_Valid_Error if Input_Object is not valid (open).
procedure Replace_Char (Input_Object : in out File_Input_Type);
-- Replaces the last character read (with Get_Char); the next call
-- to Get_Char will return it.
-- Raises: Not_Valid_Error if Input_Object is not valid (open).
function Line_String (Input_Object : in File_Input_Type) return String;
-- Returns a string representing the line number and entity.
-- Usually used in error messages.
-- Raises: Not_Valid_Error if Input_Object is not valid (open).
procedure Start_Recording (Input_Object : in out File_Input_Type);
-- Start recording all characters read into a local buffer.
-- Use this when text needs to be formatted into the output
-- file *and* be saved for future use.
-- Raises: Not_Valid_Error if Input_Object is not valid (open).
procedure Stop_Recording_and_Read_Result
(Input_Object : in out File_Input_Type; Result : out String;
Len : out Natural);
-- Stop recording characters read. Put the result into Result,
-- and the number of characters written into Len.
-- Raises: Not_Valid_Error if Input_Object is not valid (open).
private
type File_Input_Type is new ARM_Input.Input_Type with record
Is_Valid : Boolean := False;
Fyle : Ada.Text_IO.File_Type;
Line_Counter : Natural := 0;
Buffer : String(1..250);
Buffer_Last : Natural := 0;
Buffer_Index : Natural := 0; -- Last character read from buffer.
Extra_LF : Boolean := False;
-- For recording:
Recording : Boolean := False;
Recording_Buffer : String(1..ARM_Input.MAX_RECORDING_SIZE);
Recording_Len : Natural := 0;
Recording_Start_Line : Natural := 0;
-- Name:
Name : String(1..120);
Name_Len : Natural;
end record;
end ARM_File;
arm_info-2020.1-src/progs/arm_form.ada 0000664 0000000 0000000 00000033650 13734156663 0017605 0 ustar 00root root 0000000 0000000 with Ada.Text_IO,
Ada.Strings.Fixed,
Ada.Strings.Unbounded,
Ada.Characters.Handling,
Ada.Command_Line;
with ARM_Master,
ARM_Contents,
ARM_Format;
procedure ARM_Formatter is
--
-- Ada reference manual formatter (ARM_Form).
--
-- This is the main subprogram: format the sources for the
-- Ada reference manual and other documents
-- (in a vaguely Scribe-like macro language) into the actual
-- reference manual files (in various formats).
--
-- ---------------------------------------
-- Copyright 2000, 2002, 2004, 2005, 2006, 2011, 2012, 2016, 2017, 2019
-- AXE Consultants. All rights reserved.
-- P.O. Box 1512, Madison WI 53701
-- E-Mail: randy@rrsoftware.com
--
-- ARM_Form is free software: you can redistribute it and/or modify
-- it under the terms of the GNU General Public License version 3
-- as published by the Free Software Foundation.
--
-- AXE CONSULTANTS MAKES THIS TOOL AND SOURCE CODE AVAILABLE ON AN "AS IS"
-- BASIS AND MAKES NO WARRANTY, EXPRESS OR IMPLIED, AS TO THE ACCURACY,
-- CAPABILITY, EFFICIENCY, MERCHANTABILITY, OR FUNCTIONING OF THIS TOOL.
-- IN NO EVENT WILL AXE CONSULTANTS BE LIABLE FOR ANY GENERAL,
-- CONSEQUENTIAL, INDIRECT, INCIDENTAL, EXEMPLARY, OR SPECIAL DAMAGES,
-- EVEN IF AXE CONSULTANTS HAS BEEN ADVISED OF THE POSSIBILITY OF SUCH
-- DAMAGES.
--
-- A copy of the GNU General Public License is available in the file
-- gpl-3-0.txt in the standard distribution of the ARM_Form tool.
-- Otherwise, see .
--
-- If the GPLv3 license is not satisfactory for your needs, a commercial
-- use license is available for this tool. Contact Randy at AXE Consultants
-- for more information.
--
-- ---------------------------------------
--
-- Edit History:
--
-- 3/ 9/00 - RLB - Created base program.
-- 4/14/00 - RLB - Created from analysis program.
-- 4/18/00 - RLB - Added scanning pass.
-- 4/19/00 - RLB - Split 03 into two files. Added HTML output object.
-- 4/24/00 - RLB - Added Change_Kind and Display_Index_Entries.
-- 5/15/00 - RLB - Split formatter from input.
-- 5/16/00 - RLB - Added missing Destroy for formatting objects.
-- 5/18/00 - RLB - Added RTF output object.
-- 5/25/00 - RLB - Added the Big-Files option. Added the library separator.
-- 5/28/00 - RLB - Added index.
-- 8/31/00 - RLB - Added the New-Changes option.
-- 7/18/02 - RLB - Changed copyright date.
-- - RLB - Changed Creates to include title and header.
-- - RLB - Added Version parameter to command line and formatting
-- commands.
-- 9/10/04 - RLB - Updated descriptions of standard commands.
-- 9/14/04 - RLB - Moved version to ARM_Contents.
-- 12/05/04 - RLB - Split/added various source files.
-- 6/ 2/05 - RLB - Added Corrigendum output module for comparisons to
-- Amendment document.
-- 10/12/05 - RLB - Changed the title to reflect what we learned from ISO.
-- 10/28/05 - RLB - Added Annex Q.
-- 1/ 5/06 - RLB - Revised to use master files, rather than hard-coded
-- properties.
-- 1/12/06 - RLB - Removed Document completely.
-- 10/18/11 - RLB - Changed to GPLv3 license.
-- 10/19/11 - RLB - Removed junk withs (now in master file handler).
-- 4/ 3/12 - RLB - Removed dead variable.
-- 8/31/12 - RLB - Added output path parameter.
-- 3/17/16 - RLB - Added lower version to command line.
-- Standard commands for Ada standards:
-- For Original (Ada 95) RM:
-- Arm_Form RM No-Changes 0 0
-- For Original AARM:
-- Arm_Form AARM No-Changes 0 0
-- For RM with Corr:
-- [With change bars for Word 97/2000:]
-- Arm_Form RM RTF New-Changes 1 1
-- [Final versions with no changes:]
-- Arm_Form RM New-Only 1 1
-- For AARM with Corr:
-- [HTML; RTF for display]:
-- Arm_Form AARM Show-Changes 1 1
-- [TXT; RTF for printing]:
-- Arm_Form AARM New-Only 1 1
-- For RM with Corr and Amd:
-- [With change bars for Word 97/2000:]
-- Arm_Form RM RTF New-Changes 1 2
-- [With change ballons for Word XP/2003:]
-- Arm_Form RM RTF Show-Changes 1 2
-- [Final versions with no changes:]
-- Arm_Form RM New-Only 1 2
-- For AARM with Corr and Amd:
-- [HTML; RTF for display]:
-- Arm_Form AARM Show-Changes 2 2
-- (for only Amd changes) or
-- Arm_Form AARM Show-Changes 1 2
-- (for all changes)
-- [TXT; RTF for printing]:
-- Arm_Form AARM New-Only 2 2
-- For Ada 2012 RM: (To include TC1, change 3 to 4).
-- [With change ballons for Word XP/2003:]
-- Arm_Form RM RTF Show-Changes 1 3
-- [For change bar version for Word 97/2000:]
-- Arm_Form RM RTF Show-Changes 3 3
-- [Final versions with no changes:]
-- Arm_Form RM New-Only 3 3
-- For Ada 2012 AARM: (To include TC1, change 3 to 4).
-- [HTML; RTF for display]:
-- Arm_Form AARM Show-Changes 3 3
-- (for only Amd 2012 changes) or
-- Arm_Form AARM Show-Changes 1 3
-- (for all changes)
-- [TXT; RTF for printing]:
-- Arm_Form AARM New-Only 1 3
-- For Ada 202x RM:
-- [For change bar version:]
-- Arm_Form RM RTF Show-Changes 4 5
-- [Final versions with no changes:]
-- Arm_Form RM New-Only 5 5
-- For Ada 202x AARM with:
-- [HTML; RTF for display]:
-- Arm_Form AARM Show-Changes 4 5
-- (for only Amd 2012 changes) or
-- Arm_Form AARM Show-Changes 1 5
-- (for all changes)
-- [TXT; RTF for printing]:
-- Arm_Form AARM New-Only 5 5
No_Command_Error : exception;
Format : ARM_Master.Output_Format_Type; -- Format to generate.
Master_File : Ada.Strings.Unbounded.Unbounded_String; -- Master file for document to generate.
Change_Kind : ARM_Format.Change_Kind; -- Changes to generate.
Base_Change_Version : ARM_Contents.Change_Version_Type; -- Lower Change version.
Change_Version : ARM_Contents.Change_Version_Type; -- (Upper) Change version.
Output_Path : Ada.Strings.Unbounded.Unbounded_String; -- Output path.
procedure Get_Commands is
-- Process the command line for this program.
begin
if Ada.Command_Line.Argument_Count not in 1 .. 6 then
Ada.Text_IO.Put_Line ("** Wrong number of arguments");
raise No_Command_Error;
end if;
if Ada.Command_Line.Argument_Count >= 6 then
Output_Path := Ada.Strings.Unbounded.To_Unbounded_String(
Ada.Strings.Fixed.Trim (Ada.Command_Line.Argument(6),
Ada.Strings.Right));
-- Check that the Output_Path ends with a path separator.
-- Note: This is a simple Windows check; it doesn't check for and
-- allow bare disk names. This check works on Linux but allows
-- ending with '\' which does not work on Linux (that will be
-- failed when the files are opened).
declare
Last : constant Character :=
Ada.Strings.Unbounded.Element (Ada.Strings.Unbounded.Tail (Output_Path, 1), 1);
begin
if Last = '/' or else Last = '\' then
null; -- OK; this ends with a path separator.
else
Ada.Text_IO.Put_Line ("** Output path does not end with a path separator: " &
Ada.Strings.Unbounded.To_String (Output_Path));
raise No_Command_Error;
end if;
end;
else
Output_Path := Ada.Strings.Unbounded.To_Unbounded_String
("./output/"); -- Use '/' so this works on Linux and Windows.
end if;
if Ada.Command_Line.Argument_Count >= 5 then
declare
Version_Arg : String :=
Ada.Characters.Handling.To_Lower (
Ada.Strings.Fixed.Trim (Ada.Command_Line.Argument(5),
Ada.Strings.Right));
begin
if Version_Arg'Length = 1 and then
Version_Arg(Version_Arg'First) in ARM_Contents.Change_Version_Type then
Change_Version := Version_Arg(Version_Arg'First);
else
Ada.Text_IO.Put_Line ("** Unrecognized change version: " & Version_Arg);
raise No_Command_Error;
end if;
end;
else
Change_Version := '0';
end if;
if Ada.Command_Line.Argument_Count >= 4 then
declare
Version_Arg : String :=
Ada.Characters.Handling.To_Lower (
Ada.Strings.Fixed.Trim (Ada.Command_Line.Argument(4),
Ada.Strings.Right));
begin
if Version_Arg'Length = 1 and then
Version_Arg(Version_Arg'First) in ARM_Contents.Change_Version_Type then
Base_Change_Version := Version_Arg(Version_Arg'First);
else
Ada.Text_IO.Put_Line ("** Unrecognized change version: " & Version_Arg);
raise No_Command_Error;
end if;
end;
else
Base_Change_Version := '0';
end if;
if Ada.Command_Line.Argument_Count >= 3 then
declare
Changes_Arg : String :=
Ada.Characters.Handling.To_Lower (
Ada.Strings.Fixed.Trim (Ada.Command_Line.Argument(3),
Ada.Strings.Right));
begin
if Changes_Arg = "no-changes" then
Change_Kind := ARM_Format.Old_Only;
elsif Changes_Arg = "new-only" then
Change_Kind := ARM_Format.New_Only;
elsif Changes_Arg = "show-changes" then
Change_Kind := ARM_Format.Show_Changes;
elsif Changes_Arg = "new-changes" then
Change_Kind := ARM_Format.New_Changes;
else
Ada.Text_IO.Put_Line ("** Unrecognized changes: " & Changes_Arg);
raise No_Command_Error;
end if;
end;
else
Change_Kind := ARM_Format.New_Only;
end if;
if Ada.Command_Line.Argument_Count >= 2 then
declare
Format_Arg : String :=
Ada.Characters.Handling.To_Lower (
Ada.Strings.Fixed.Trim (Ada.Command_Line.Argument(2),
Ada.Strings.Right));
begin
if Format_Arg = "rtf" then
Format := ARM_Master.RTF;
elsif Format_Arg = "html" then
Format := ARM_Master.HTML;
elsif Format_Arg = "text" then
Format := ARM_Master.Text;
elsif Format_Arg = "corr" then
Format := ARM_Master.Corr;
elsif Format_Arg = "info" then
Format := ARM_Master.Info;
else
Ada.Text_IO.Put_Line ("** Unrecognized format: " & Format_Arg);
raise No_Command_Error;
end if;
end;
else
Format := ARM_Master.HTML;
end if;
declare
use type Ada.Strings.Unbounded.Unbounded_String;
begin
Master_File := Ada.Strings.Unbounded.To_Unbounded_String(
Ada.Strings.Fixed.Trim (Ada.Command_Line.Argument(1),
Ada.Strings.Right));
if Ada.Strings.Unbounded.Index (Master_File, ".") = 0 then
-- Add extension if it is missing.
Master_File := Master_File & ".MSM";
end if;
end;
exception
when No_Command_Error =>
Ada.Text_IO.Put_Line (" Usage: Arm_Form [[ [ [ [