[net.emacs] Ada Mode

rosen@siemens.UUCP (05/01/85)

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

                        Ada Mode for Gosling Emacs

                             Steven M. Rosen

                 Siemens Corporate Research and Support, Inc.
                    Research and Technology Laboratories
                            Princeton, NJ 08540
                              (609) 734-6538

                               rosen@siemens

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

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 are 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.

Place the file 'ada.ml' in your local Emacs Mlisp code library directory.
This is usually something like '/usr/lib/emacs/maclib'.

To have the editor invoke the Ada mode when editing Ada source code, place
the following lines in your '.emacs_pro' profile script.

        (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"

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 writting 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, 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
        
        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.

        ^X->             Indents a region of code from 'dot' to 'mark' by
                         the value 'indent-change'.

        ^X-<             Dedents a region of code from 'dot' to 'mark' by
                         the value 'indent-change'.

        <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.

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

        <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!


        '--'             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 <CR> on
                         a blank line (after a '--' has been automatically
                         inserted), will leave the comment mode and return
                         you to editing statement editing by repositioning
                         the cursor in the correct place.

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

rosen@siemens.UUCP (05/01/85)

; ----------------------------------------------------------------------------
; ada.ml - Ada mode for Emacs
; ----------------------------------------------------------------------------
;  
;                         Ada Mode for Gosling Emacs
;  
;                              Steven M. Rosen
;  
;                  Siemens Corporate Research and Support, Inc.
;                     Research and Technology Laboratories
;                             Princeton, NJ 08540
;                                (609) 734-6538
;  
;                                 rosen@siemens
; 
; ----------------------------------------------------------------------------
; 
; 	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 4.1 85/04/15 08:33:06 rosen Exp $
; 
; Created 12-18-84
; Updated 04-15-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				  "--"
; 
; 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)
	(setq-default indent-change 2)
	(setq tab-size 8)
	(setq in-comment-edit 0)
	(setq mode-string "Ada")
	(use-syntax-table "Ada")
	(setq abbrev-mode 1)
	(local-bind-to-key "begin-ada-comment" "-")
	(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 "show-matching-paren" ")")
; 
; The following two lines can be include to suit local naming 
; conventions:
; 
;	(modify-syntax-entry "w    _")
;	(modify-syntax-entry "w    .")
; 
;
	(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]*-- \n"))
			(progn 
			       (setq in-comment-edit 0)
			       (beginning-of-line)
			       (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 "begin-ada-comment" "-")
			       (local-bind-to-key "tab-ada" "\t")
			       (message "Finished editing ada comment"))
			(& (= in-comment-edit 1)
			   (! (looking-at "[ \t]*--[ \t]*..")))
			(progn 
			       (end-of-line)
			       (newline)
			       (to-col comment-column)
			       (insert-string "-- "))
			(& (= in-comment-edit 1)
			   (looking-at "[ \t]*--[ \t]*.."))
			(progn 
			       (end-of-line)
			       (newline-and-indent)
			       (insert-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")
			    (looking-at "[ \t]*.*:[ \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
    (begin-ada-comment c
	(insert-character (last-key-struck))
	(remove-local-binding "-")
	(remove-local-binding "\t")
	(setq c (get-tty-character))
	(insert-character c)
	(if 
	    (&
	      (= c 45)
	      (looking-at "[ \t]*\n"))
	    (progn 
		   (setq in-comment-edit 1)
		   (setq comment-column (- (current-column) 2))
		   (move-to-comment-column)
		   (setq left-margin comment-column)
		   (setq right-margin 76)
		   (setq prefix-string "-- ")
		   (cond 
			 (looking-at "[ \t]*--")
			 (progn 
				(end-of-line)
				(newline)
				(to-col comment-column)
				(insert-string "-- "))
			 1
			 (end-of-line))
		   (message "Editing ada comment")
	    )
	    1
	    (progn 
		   (local-bind-to-key "begin-ada-comment" "-")
		   (local-bind-to-key "tab-ada" "\t")
	    ))
    )
)

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