Programmer's ROM - The Computer Language Library/programmersrom.iso/ada/extrnl/adamode.src

Text File | 1988-05-03 | 29.5 KB | 1,081 lines

::::::::::
ada-mode.pro
::::::::::

-------- SIMTEL20 Ada Software Repository Prologue ------------
--                                                           -*
-- Unit name    : Ada mode for Gosling Emacs
-- Version      : 5.5
-- Author       : Steve Rosen
--              : Siemens Research and Technology Laboratories
--              : 105 College Road East
--              : Princeton, NJ 08540
-- DDN Address  : siemens!gypsy!rosen@TOPAZ
-- Copyright    :
-- Date created :  December 12, 1984
-- Release date :  December 17, 1985
-- Last update  :  Version 5.5 of December 17, 1985
-- Machine/System Compiled/Run on : Vax 11/780 with Unix 4.2BSD
--                  : Emacs version = Gosling #264
--                                                           -*
---------------------------------------------------------------
--                                                           -*
-- Keywords     :  Emacs, Editor, Mode
----------------:
--
-- Abstract     :  This set of files constitues a special
----------------:  'ada-mode' for use with the Emacs editor.
----------------:  See the file 'help-ada-mode.doc' for more
----------------:  information.
----------------:
------------------ Revision history ---------------------------
--                                                           -*
-- DATE         VERSION    AUTHOR                  HISTORY
-- 12/17/85      5.5    Rosen            Second Release
--                                                           -*
------------------ Distribution and Copyright -----------------
--                                                           -*
-- This prologue must be included in all copies of this software.
--
-- This software is copyright by the author.
--
-- This software is released to the Ada community.
-- This software is released to the Public Domain (note:
--   software released to the Public Domain is not subject
--   to copyright protection).
-- Restrictions on use or distribution:  NONE
--                                                           -*
------------------ Disclaimer ---------------------------------
--                                                           -*
-- This software and its documentation are provided "AS IS" and
-- without any expressed or implied warranties whatsoever.
-- No warranties as to performance, merchantability, or fitness
-- for a particular purpose exist.
--
-- Because of the diversity of conditions and hardware under
-- which this software may be used, no warranty of fitness for
-- a particular purpose is offered.  The user is advised to
-- test the software thoroughly before relying on it.  The user
-- must assume the entire risk and liability of using this
-- software.
--
-- In no event shall any person or organization of people be
-- held responsible for any direct, indirect, consequential
-- or inconsequential damages or lost profits.
--                                                           -*
-------------------END-PROLOGUE--------------------------------
::::::::::
ada-mode-help.doc
::::::::::
----------------------------------------------------------------------------
ada-mode-help.doc - Help for Emacs Ada mode
----------------------------------------------------------------------------

            Ada Mode for Gosling Emacs

          (emacs-version) => Emacs #264 of Mon May 16

                 Steven M. Rosen

         Siemens Corporate Research and Support, Inc.
            Research and Technology Laboratories
                Princeton, NJ 08540
                  [phone]

                -----------

            USENET:       adrvax\
                    ihnp4 |
                princeton |-->!siemens!gypsy!rosen
                    topaz |
                   vrdxhq/

            ARPA:    siemens!gypsy!rosen@TOPAZ


------------------------------------------------------------------------------

*** What is it? ***

The Ada mode Mlisp code defines a special mode for the Gosling version of
the Emacs editor.  How it works with other versions of Emacs is unclear,
since it was written for and tested with the Gosling version.  The Ada mode
is intended for use when editing Ada code and it is case insensitive when
dealing with reserved Ada words.

The information provided in this document is geared towards Unix, however,
it may be possible to install "ada-mode" under other operation systems such
as VMS which can also run Emacs.


*** What components is it comprised of? ***

The current version of "ada-mode" utilizes two Mlisp files.  There is also a
text file.  These files are as follows:

    o ada.ml

      -- All of the major functions used by ada-mode.

    o justify-Ada-comment.ml

      -- Special functions for justifying blocks of Ada comments.

    o ada-mode-help.doc

      -- This file.


*** How do I install it? ***

Place the first two of the above files (the ones ending in '.ml' into your
local Emacs Mlisp library.  Typically this is something like
'/usr/lib/emacs/maclib'.  It is possible that it may be named something
else.

As an alternative, you may place these files is some other directory and add
this directory to your 'csh' environment variable, EPATH.  If you do this,
your EPATH variable might be set like this:

    setenv EPATH :/usr/rosen/mlisp:/usr/lib/emacs/maclib

You can place this 'setenv' statement in your '.login' file.

Once you have installed the Mlisp files in the correct place, you can then
have Emacs invoke the "ada-mode" automatically when editing Ada source code,
place the following lines in your '.emacs_pro' profile script.  This profile
script can be found in your home directory.

        (autoload "ada-mode" "ada.ml")
        (auto-execute "ada-mode" "*.ada")

You can change the second line to have the Ada mode loaded when you are
editing files with extensions other than ".ada" (such as "*.a" or "*.txt" or
whatever).

You should now be able to utilize "ada-mode".

*** What it does ***

Ada mode automatically performs indenting while you are editing Ada code.
Is assumes that you are using a style that is similar to that used in the
Ada LRM (Language Reference Manual).  It automatically indents and dedents
blocks of code by examing the syntax of the statements that you are writing.
Using very unusually or ad hoc coding styles will not produce results that
are anything spectacular.

Using this editing mode takes a bit of getting used to, but it shouldn't
take long to become comfortable with it.  It is far from perfect, but I felt
a strong need to write it because the power of Emacs is too good to put to
waste and I was writing too much Ada code to be without it.  For those of
you who attempt to make it run with other versions of Emacs please let me
know since I know nothing of how other versions differ from the Gosling
version.  If you have any questions or find very strange bugs, send them to
the above address and I will attempt to fix them.  The comment mode was
particularly hard to implement and might be considered somewhat of a hack,
but it does work fairly well when writting most comments.  I can't promise
that writting comments won't do strange stuff every so often.  If you fix a
bug or make an enhancement send it to me so I can enjoy it as well.  Have
fun!

------------------------------------------------------------------------------

Variables and Functions

    o indent-change

            The number of spaces to use when indenting
            statements.  This number can be changed to 4 or
            whatever you like.  The default is 2. This
            can be changed in the file 'ada.ml'.

    o ada-comment-header

            This is a string which designates what begins a
            comment.  For Ada, this is always "--", but may
            be changed to "--|" if you would like to extend
            the comment designator.     The default is "--".  This
            can be changed in the file 'ada.ml'

    o ^X->

            Indents a region of code from 'dot' to 'mark' by
            the 'indent-change' spaces.

    o ^X-<

            Dedents a region of code from 'dot' to 'mark' by
            the 'indent-change' spaces.

    o <ESC>-<TAB>

            Tab over to the column of the previous statement.
            If at the beginning of a line, this will move the
            cursor over to the same column as the most recent
            line of code.  If the current column is greater
            that the column of the most recent line of code,
            then a <TAB> character is inserted.

    o <TAB>

            Same as above, but you can disable the key binding
            if hitting a <TAB> does things that you don't like.

    o <ESC>-<CR>

            If at the end of a line. inserts a <CR> and dedents
            by 'indent-change'.  If on a blank like, it just
            dedents by 'indent-change'.  This is used, for
            example, when you wish to dedent a block of code,
            and insert an 'end' statement such as in a 'for'
            loop.

            Example:

                  for i in 1 .. 100 loop
                    j := x(1);
                    z := sqrt(j); -- Type an <ESC>-<CR> here
                  end loop;

            The <ESC>-<CR> is a signal that you want to close off
            a block of code with and 'end' statement.  If you
            have forgotten to type the <ESC>-<CR> sequence and
            you are sitting on a blank line type it anyway and
            you will be repositioned automatically!


    o <ESC>-'-'

            Comments out the region of statements between dot
            and mark.

    o '--'

            Typing these two characters will automatically put
            you into a special comment editing mode.  This mode
            will wrap lines automatically when you are typing
            long comments.     The characters '--' are
            automatically created and inserted so the user does
            not have to type them when writing a comment that
            carries over to several lines.     Typing a <LF> on
            a comment line will leave the comment mode and return
            you to regular statement editing by repositioning
            the cursor in the correct place.

    o <ESC>-'j'

            Justify a block of Ada comments.  This key
            sequence can be typed while the cursor is anywhere
            within a block of comments.  The entire block
            will become justified.     A block of comments is
            defines as a series of contiguous non-blank comment
            statements.  This function may not be perfect, but it
            does become extremely convient when editing large
            chunks of text within part of an Ada program.

------------------------------------------------------------------------------
::::::::::
ada.ml
::::::::::
 ----------------------------------------------------------------------------
; Ada.ml - Emacs Ada mode
; ----------------------------------------------------------------------------
;
;                        Ada Mode for Gosling Emacs
;
;          (emacs-version) => Emacs #264 of Mon May 16
;
;                             Steven M. Rosen
;
;                 Siemens Corporate Research and Support, Inc.
;                    Research and Technology Laboratories
;                            Princeton, NJ 08540
;                              [phone]
;
;                -----------
;
;            USENET:    adrvax\
;                        ihnp4 |
;                    princeton |-->!siemens!gypsy!rosen
;                        topaz |
;                       vrdxhq/
;
;            ARPA:   siemens!gypsy!rosen@TOPAZ
;
;
;----------------------------------------------------------------------------
;
;     This code is public domain and may be used or modified at your site
;     in any fashion that you choose.  No support or capabilities are
;     implied or guaranteed by the release of this code.  This disclaimer
;    must be maintained in conjunction with the code.
;
; ----------------------------------------------------------------------------
;
; $Header: ada.ml,v 5.5 85/12/17 11:53:39 rosen Exp $
;
; Created 12-18-84
; Updated 12-13-85
;
; Bindings:
;
;     indent-change = size of indentation (default to 2)
;
;     Indent from (dot) to (mark)              ^X->
;     De-dent from (dot) to (mark)              ^X-<
;     Tab over to indent of most recent line of code      <TAB>, <ESC>-<TAB>
;     Decrease indent level and start newline          <ESC>-<CR>
;     Enter Ada comment mode                  "--"
;     Finish an Ada comment (leave comment mode)        <LF> or <ESC>-'-'
;     Comment out the region between dot and mark      ^X-'-'
;     Beautify an Ada comment                  <ESC>-'j'
;
; Features:
;
;   o    Automatically performs indentation while editing Ada code.
;
;   o    Automatically performs justification of Ada comments which
;     begin on a blank line.
;
;   o    Automatically matches parentheses.
;
;


(defun
    (ada-mode
    (declare-buffer-specific in-comment-edit)
    (declare-buffer-specific max-right-margin)
    (declare-buffer-specific comment-header)
    (setq mode-string "Ada")
    (setq comment-header "--")
    (setq-default indent-change 2)
    (setq tab-size 8)
    (setq max-right-margin 78)
    (setq in-comment-edit 0)
    (local-bind-to-key "Ada-comment" "-")
    (local-bind-to-key "finish-Ada-comment" "\e-")
    (local-bind-to-key "finish-Ada-comment" "\^J")
    (local-bind-to-key "indent-region" "\^X>")
    (local-bind-to-key "dedent-region" "\^X<")
    (local-bind-to-key "tab-Ada" "\t")
    (local-bind-to-key "tab-Ada" "\e\t")
    (local-bind-to-key "indent-Ada" "\^M")
    (local-bind-to-key "de-dent-Ada" "\e\^M")
    (local-bind-to-key "comment-out-region" "\^X-")
    (local-bind-to-key "show-matching-paren" ")")
    (load "justify-Ada-comment.ml")
;
; The following two lines can be include to suit local naming
; conventions:
;
;    (modify-syntax-entry "w    _")
;    (modify-syntax-entry "w    .")
;
    (use-syntax-table "Ada")
    (modify-syntax-entry "()   (")
    (modify-syntax-entry ")(   )")
    (modify-syntax-entry "     """)
    (modify-syntax-entry "     '")
    (modify-syntax-entry "  { --")
    (modify-syntax-entry "   } \n")

    (error-occurred (Ada-mode-hook))
    (novalue)
    )
)

(defun
    (cond n running
      (setq n 1)
      (setq running 1)
      (while (& running (< n (nargs)))
         (if (arg n)
             (setq running 0)
             (setq n (+ n 2))
         )
      )
      (arg (+ n 1))
    )
)

(defun
    (show-matching-paren
    (insert-character (last-key-struck))
    (save-excursion
        (backward-paren)
        (if (dot-is-visible)
        (sit-for 5)
        (progn
               (beginning-of-line)
               (set-mark)
               (end-of-line)
               (message (region-to-string))
        )
        )
    )
    )
)


(defun
    (leave-and-show
    (setq abbrev-mode 1)
    (show-matching-paren)
    )
)

(defun
    (change-indentation colno    ; indent by arg for region
    (save-excursion
        (if (< (mark) (dot))
        (progn
               (end-of-line)
               (exchange-dot-and-mark)
               (beginning-of-line))
        (progn
               (beginning-of-line)
               (exchange-dot-and-mark)
               (end-of-line)))
        (narrow-region)
        (end-of-file)
        (beginning-of-line)
        (setq colno (+ (current-indent) (arg 1)))
        (delete-white-space)
        (if (> colno 1)
        (to-col colno))
        (beginning-of-line)
        (while (! (bobp))
           (previous-line)
           (setq colno (+ (current-indent) (arg 1)))
           (delete-white-space)
           (if (> colno 1)
               (to-col colno)
           )
           (beginning-of-line)
        )
        (widen-region)
    )
    )
)

(defun
    (dedent-region         ; dedents region
    (change-indentation (- 0 indent-change))
    )
)

(defun
    (indent-region colno    ; indents region
    (change-indentation indent-change)
    )
)

(defun
    (tab-Ada dotab colno
    (if
        (& (eobp) (eolp))
        (progn
           (insert-character '\n')
           (backward-character)
        )
    )
    (if
        (| (& (bolp) (looking-at "[ \t]*\n"))
           (< (current-column) (current-indent)))
        (progn
           (save-excursion
               (while
                  (& (| (looking-at "[ \t]*\n")
                    (looking-at "[ \t]*--"))
                 (! (bobp)))
                  (progn
                     (previous-line)
                     (beginning-of-line)
                  )
               )
               (setq colno (current-indent))
           )
           (delete-white-space)
           (to-col colno)
        )
        1
        (insert-character '\t')
    )
    )
)

(defun
    (de-dent-Ada colno
    (setq colno (- (current-indent) indent-change))
    (beginning-of-line)
    (if
        (! (looking-at "[ \t]*\n"))
            (progn
                (end-of-line)
                (newline)
            )
    )
    (delete-white-space)
    (to-col colno)
    )
)

(defun
    (indent-Ada colno
    (cond
         (bolp)
         (newline)
         (! (eolp))
         (newline-and-indent)
         1
         (progn
           (save-excursion
               (end-of-line)
               (if (eobp)
               (newline)))
           (setq colno (current-indent))
           (beginning-of-line)
           (setq case-fold-search 1)
           (cond
            (& (= in-comment-edit 1)
               (! (looking-at "[ \t]*--..")))
            (progn
                   (end-of-line)
                   (newline)
                   (to-col comment-column)
                   (insert-string prefix-string))
            (& (= in-comment-edit 1)
               (looking-at "[ \t]*--.."))
            (progn
                   (set-prefix-string)
                   (end-of-line)
                   (newline-and-indent)
                   (insert-string prefix-string))
            (looking-at "[ \t]*--.*\n")
            (progn
                   (end-of-line)
                   (newline)
                   (tab-Ada))
            (looking-at "[ \t]*begin\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*end\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (- colno indent-change)))
            (looking-at "[ \t]*when\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*generic\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*declare\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*loop\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*if\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*elsif\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*else\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*while\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*case\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*for\\b")
            (progn
                   (end-of-line)
                   (if (= (preceding-char) ';')
                   (newline-and-indent)
                   (progn
                      (newline)
                      (to-col (+ colno indent-change)))))
            (looking-at "[ \t]*loop\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*or\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*exception\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*record\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*private\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (| (looking-at "[ \t]*type\\b")
               (looking-at "[ \t]*subtype\\b"))
            (progn
                   (end-of-line)
                   (backward-word)
                   (if
                   (looking-at "record\\b")
                   (progn
                      (setq colno (current-column))
                      (end-of-line)
                      (newline)
                      (to-col (+ colno indent-change)))
                   (looking-at "is\\b")
                   (progn
                      (end-of-line)
                      (newline)
                      (to-col (+ colno indent-change)))
                   1
                   (progn
                      (end-of-line)
                      (newline-and-indent))))
            (looking-at "[ \t]*select\\b")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*accept\\b")
            (progn
                   (end-of-line)
                   (backward-word)
                   (if (looking-at "do\\b")
                   (progn
                      (end-of-line)
                      (newline)
                      (to-col (+ colno indent-change)))
                   (progn
                      (end-of-line)
                      (newline-and-indent))))
            (looking-at "[ \t]*task\\b")
            (progn
                   (end-of-line)
                   (backward-word)
                   (if (looking-at "is\\b")
                   (progn
                      (end-of-line)
                      (newline)
                      (to-col (+ colno indent-change)))
                   (progn
                      (end-of-line)
                      (newline-and-indent))))
            (| (looking-at "[ \t]*procedure\\b")
               (looking-at "[ \t]*function\\b"))
            (progn
                   (end-of-line)
                   (backward-word)
                   (if (looking-at "is\\b")
                   (progn
                      (end-of-line)
                      (newline)
                      (to-col (+ colno indent-change)))
                   (progn
                      (end-of-line)
                      (newline-and-indent))))
            (looking-at "[ \t]*package\\b")
            (progn
                   (end-of-line)
                   (backward-word)
                   (if (looking-at "is\\b")
                   (progn
                      (end-of-line)
                      (newline)
                      (to-col (+ colno indent-change)))
                   (progn
                      (end-of-line)
                      (newline-and-indent))))
            (looking-at "[ \t]*.*:[^=][^;.]*\n")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            (looking-at "[ \t]*<<.*>>")
            (progn
                   (end-of-line)
                   (newline)
                   (to-col (+ colno indent-change)))
            1
            (progn
                  (setq colno (current-indent))
                  (if (looking-at "[ \t][ \t]*\n")
                  (kill-to-end-of-line))
                  (end-of-line)
                  (newline)
                  (to-col colno)))
           (setq case-fold-search 0)))))

(defun
    (Ada-comment next-char
    (insert-string "-")
    (setq next-char (char-to-string (get-tty-character)))
    (if (= next-char "-")
        (progn
          (insert-string (substr comment-header 2 -1))
          (remove-local-binding "-")
          (remove-local-binding "\t")
          (setq in-comment-edit 1)
          (setq comment-column (- (current-column) 2))
          (setq left-margin comment-column)
          (setq right-margin max-right-margin)
          (message "Editing Ada comment")
          (setq prefix-string comment-header)
          (if (looking-at (concat "[ \t]*" comment-header "[ \t]*"))
              (progn
                 (indent-Ada)
                 (previous-line)
                 (end-of-line)
              )
          )
          (while (|
                (= (setq next-char
                     (char-to-string (get-tty-character)))
                   " ")
                (= next-char "\t")
             )
             (setq prefix-string (concat prefix-string next-char))
             (insert-string next-char)
          )
          (if (= prefix-string comment-header)
              (setq prefix-string (concat comment-header " "))
          )
          (push-back-string next-char)
        )
        (push-back-string next-char)
    )
    )
)


(defun
    (finish-Ada-comment
    (setq in-comment-edit 0)
    (beginning-of-line)
    (if
        (looking-at "[ \t]*--")
        (progn
           (kill-to-end-of-line)
           (kill-to-end-of-line)
        )
    )
    (if
        (looking-at "[ \t]*\n")
        (tab-Ada)
        1
        (beginning-of-line)
    )
    (setq right-margin 1000)
    (setq left-margin 1)
    (setq prefix-string "")
    (local-bind-to-key "Ada-comment" "-")
    (local-bind-to-key "tab-Ada" "\t")
    (message "Finished editing Ada comment")
    )
)


(defun
    (set-prefix-string
    (search-forward comment-header)
    (setq prefix-string comment-header)
    (while
        (looking-at "[ \t]")
        (progn
               (if
               (looking-at " ")
               (setq prefix-string (concat prefix-string " "))
               1
               (setq prefix-string (concat prefix-string "\t"))
               )
               (forward-character)
        )
    )
    )
)


(defun
    (end-Ada-comment
        (setq in-comment-edit 0)
        (setq right-margin 1000)
        (if (!= (preceding-char) ' ') (insert-string " "))
        (to-col comment-column)
        (insert-string comment-header)
        (newline)
        (local-bind-to-key "tab-Ada" "\t")
        (message "Finished editing Ada comment")
    )
)

(defun
    (comment-out-region
    (save-excursion
        (if
        (> (dot) (mark))
        (exchange-dot-and-mark)
        )
        (beginning-of-line)
        (while
           (< (dot) (mark))
           (progn
              (insert-string comment-header)
              (next-line)
              (beginning-of-line)
           )
        )
    )
    )
)
; ----------------------------------------------------------------------------
::::::::::
justify-Ada-comment.ml
::::::::::
; ----------------------------------------------------------------------------
; justify-Ada-comment.ml - Justify an Ada comment block
; ----------------------------------------------------------------------------
;
;                        Ada Mode for Gosling Emacs
;
;          (emacs-version) => Emacs #264 of Mon May 16
;
;                             Steven M. Rosen
;
;                 Siemens Corporate Research and Support, Inc.
;                    Research and Technology Laboratories
;                            Princeton, NJ 08540
;                              [phone]
;
;                -----------
;
;            USENET:    adrvax\
;                        ihnp4 |
;                    princeton |-->!siemens!gypsy!rosen
;                        topaz |
;                       vrdxhq/
;
;            ARPA:   siemens!gypsy!rosen@TOPAZ
;
;
;----------------------------------------------------------------------------
;
;     This code is public domain and may be used or modified at your site
;     in any fashion that you choose.  No support or capabilities are
;     implied or guaranteed by the release of this code.  This disclaimer
;    must be maintained in conjunction with the code.
;
; ----------------------------------------------------------------------------
;
; Used with "Ada-Mode"
;
; Justify an Ada comment.  These is a severe hack, but it works more or less.
; The user must be on the last line of a block of comment statements for the
; justification to take place.  The functions runs kind of slow, but that is
; because it attempts to space out every correctly.
;

(defun
    (justify-Ada-comment comment-start comment-leader null-comment any-comment
             comment-front
    (setq right-margin max-right-margin)
    (setq null-comment (concat "[ \t]*" comment-header "[ \t]*\n"))
    (setq any-comment (concat "[ \t]*" comment-header "[ \t]*.*"))
    (setq comment-front (concat "[ \t]*" comment-header))
    (save-excursion
        (message "Justifying Ada comment...")
        (sit-for 0)
        (beginning-of-line)
        (if
        (! (looking-at any-comment))
        (error-message "Cannot find Ada comment boundary")
        (novalue)
        )
        (while
           (& (looking-at any-comment)
              (! (looking-at null-comment)))
           (next-line)
        )
        (newline-and-backup)
        (set-mark)
        (previous-line)
        (beginning-of-line)
        (setq comment-leader comment-header)
        (re-search-forward (concat "[ \t]*" comment-header))
        (while
           (looking-at "[ \t]")
           (progn
              (if (looking-at "\t")
                  (setq comment-leader
                    (concat comment-leader "\t"))
                  (looking-at " ")
                  (setq comment-leader
                    (concat comment-leader " ")))
              (forward-character)
           )
        )
        (beginning-of-line)
        (while
           (& (looking-at any-comment)
              (& (! (bobp))
             (& (! (looking-at "[ \t]*--.*:[ \t]*\n"))
                (! (looking-at null-comment)))))
           (previous-line))
        (next-line)
        (beginning-of-line)
        (search-forward "-")
        (backward-character)
        (setq comment-start (current-column))
        (while
           (< (dot) (mark))
           (progn
              (if (= text-compression-on 1)
                  (compress-text-line)
              )
              (end-of-line)
              (if
                  (<= (current-column) right-margin)
                  (progn
                     (next-line)
                     (beginning-of-line)
                     (if
                     (looking-at comment-front)
                     (progn
                        (while
                            (looking-at comment-front)
                            (delete-next-character)
                        )
                        (delete-previous-character)
                        (while
                            (! (looking-at "[ \t]"))
                            (delete-next-character)
                        )
                        (while
                               (looking-at "[ \t]")
                               (delete-next-character)
                        )
                        (insert-character ' ')
                        (beginning-of-line)
                     )
                     )
                  )
                  1
                  (progn
                     (while
                        (> (current-column) right-margin)
                        (progn
                           (backward-word)
                           (backward-character)
                           (while
                              (! (looking-at " "))
                              (backward-character))
                        )
                     )
                     (insert-character '\n')
                     (while
                        (!= (current-column) comment-start)
                        (insert-character ' ')
                     )
                     (while
                        (looking-at "[ \t]")
                        (delete-next-character)
                     )
                     (insert-string comment-leader)
                  )
              )
           )
        )
        (exchange-dot-and-mark)
        (kill-to-end-of-line)
    )
    (message "Done!")
    )
)




(defun
    (compress-text-line
    (save-excursion
        (end-of-line)
        (set-mark)
        (beginning-of-line)
        (while
           (looking-at "[ \t]*--")
           (forward-word)
        )
        (while
          (< (dot) (mark))
          (while
             (& (< (dot) (mark))
                (! (looking-at "[ \t]")))
             (forward-character)
          )
          (while
             (& (< (dot) (mark))
                (looking-at "[ \t]"))
             (delete-next-character)
          )
          (if
              (< (dot) (mark))
              (progn
                 (backward-character)
                 (if
                 (looking-at "[\.\?\!]")
                 (progn
                    (forward-character)
                    (insert-character ' ')
                    (insert-character ' ')
                 )
                     1
                 (progn
                    (forward-character)
                         (insert-character ' ')
                 )
                 )
                 (forward-word)
              )
          )
        )
    )
    )
)

(declare-buffer-specific text-compression-on)
(setq text-compression-on 0)
(local-bind-to-key "justify-Ada-comment" "\ej")