Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!seismo!columbia!rutgers!mit-eddie!hmiller
From: hmiller@eddie.MIT.EDU (Herbert A. Miller)
Newsgroups: comp.emacs
Subject: Ada mode for GNUemacs
Message-ID: <5977@eddie.MIT.EDU>
Date: Sun, 31-May-87 15:47:36 EDT
Article-I.D.: eddie.5977
Posted: Sun May 31 15:47:36 1987
Date-Received: Tue, 2-Jun-87 02:11:54 EDT
Reply-To: hmiller@eddie.MIT.EDU (Herbert A. Miller)
Distribution: world
Organization: MIT, EE/CS Computer Facilities, Cambridge, MA
Lines: 392
Keywords: Ada GNU


After much searching without success I decided I might as well write an Ada
mode for GNU.  So, I hacked up Modula2 mode, and hear it is.  I think I've
gotten out most of the bugs under 17.64, but would appreciate any
comments/suggestions on this especially under version 18, since I haven't
completely checked it out there.  The compilation commands are set up for
the VERDIX compiler under UNIX.

--Herb Miller
ARPA:  hmiller@eddie.mit.edu
CHAOS: ham@deep-thought.mit.edu
UUCP:  ...mit-eddie!hmiller


============================================================
; Ada editing support package
; Author Mick Jordan for Modula-2
; amended Peter Robinson
; ported to GNU Michael Schmidt
; From: "Michael Schmidt" <michael@pbinfo.UUCP>
; Modified by Tom Perrine <Perrin@LOGICON.ARPA> (TEP)
; analogue for Ada by Herb Miller <hmiller@eddie.mit.edu>


(defvar ada-mode-syntax-table nil
  "Syntax table in use in Ada-mode buffers.")

(if ada-mode-syntax-table
    ()
  (let ((table (make-syntax-table)))
    (modify-syntax-entry ?\\ "\\" table)
    (modify-syntax-entry ?\( "()" table)
    (modify-syntax-entry ?\) ")(" table)
    (modify-syntax-entry ?\{ "." table)
    (modify-syntax-entry ?\} "." table)
    (modify-syntax-entry ?\[ "." table)
    (modify-syntax-entry ?\] "." table)
    (modify-syntax-entry ?/ "." table)
    (modify-syntax-entry ?\& "." table)
    (modify-syntax-entry ?\| "." table)
    (modify-syntax-entry ?\$ "." table)
    (modify-syntax-entry ?* ". " table)
    (modify-syntax-entry ?+ "." table)
    (modify-syntax-entry ?- ". 12" table)
    (modify-syntax-entry ?= "." table)
    (modify-syntax-entry ?% "." table)
    (modify-syntax-entry ?< "(>" table)
    (modify-syntax-entry ?> ")<" table)
    (modify-syntax-entry ?\' "\'" table)
    (modify-syntax-entry ?\" "\"" table)
    (setq ada-mode-syntax-table table)))

(defvar ada-mode-map nil
  "Keymap used in Ada mode.")

(if ada-mode-map ()
  (let ((map (make-sparse-keymap)))
    (define-key map "\^i" 'ada-tab)
    (define-key map "\C-m" 'ada-newline)
    (define-key map "\C-cc" 'ada-case)
    (define-key map "\C-c\-" 'ada-comment)
    (define-key map "\C-cd" 'ada-declare)
    (define-key map "\C-ce" 'ada-else)
    (define-key map "\C-cf" 'ada-for)
    (define-key map "\C-c\C-f" 'ada-function)
    (define-key map "\C-ch" 'ada-header)
    (define-key map "\C-ci" 'ada-if)
    (define-key map "\C-ck" 'ada-package-spec)
    (define-key map "\C-cK" 'ada-package-body)
    (define-key map "\C-cl" 'ada-loop)
    (define-key map "\C-cp" 'ada-procedure)
    (define-key map "\C-c\C-w" 'ada-with)
    (define-key map "\C-cr" 'ada-record)
    (define-key map "\C-cs" 'ada-stdio)
    (define-key map "\C-ct" 'ada-task-spec)
    (define-key map "\C-cT" 'ada-task-body)
    (define-key map "\C-cw" 'ada-while)
    (define-key map "\C-c\C-z" 'suspend-emacs)
    (define-key map "\C-c\C-t" 'ada-toggle)
    (define-key map "\C-c\C-l" 'ada-link)
    (define-key map "\C-c\C-c" 'ada-compile)
    (setq ada-mode-map map)))

(defvar ada-indent 4 "*This variable gives the indentation in Ada-Mode")

(defun ada-mode ()
"This is a mode intended to support program development in Ada.
Most control constructs of Ada can be reached by typing
Control-C followed by the first character of the construct.

  Control-c c case          Control-c d declare
  Control-c e else          Control-c f for
  Control-c h header        Control-c i if
  Control-c k package spec. Control-c K package body
  Control-c l loop          Control-c p procedure
  Control-c r record        Control-c s stdio
  Control-c t task spec.    Control-c T task body
  Control-c w while         Control-c Control-w with
  Control-c - comment
  Control-c Control-f function          Control-c Control-t toggle
  Control-c Control-z suspend-emacs     Control-c Control-c compile
  Control-c Control-c link              Control-x ` next-error

\\{ada-mode-map}

Variable ada-indent controls the number of spaces for each indentation."
  (interactive)
  (kill-all-local-variables)
  (use-local-map ada-mode-map)
  (setq major-mode 'ada-mode)
  (setq mode-name "Ada")
  (make-local-variable 'comment-column)
  (setq comment-column 1)
  (make-local-variable 'end-comment-column)
  (setq end-comment-column 75)
  (set-syntax-table ada-mode-syntax-table)
  (make-local-variable 'paragraph-start)
  (setq paragraph-start (concat "^$\\|" page-delimiter))
  (make-local-variable 'paragraph-separate)
  (setq paragraph-separate paragraph-start)
;  (make-local-variable 'indent-line-function)
;  (setq indent-line-function 'c-indent-line)
  (make-local-variable 'require-final-newline)
  (setq require-final-newline t)
  (make-local-variable 'comment-start)
  (setq comment-start "-- ")
  (make-local-variable 'comment-end)
  (setq comment-end "\C-j")
  (make-local-variable 'comment-start-skip)
  (setq comment-start-skip "-- ")
  (make-local-variable 'parse-sexp-ignore-comments)
  (setq parse-sexp-ignore-comments nil) ; newline is not always end of comment
  (run-hooks 'ada-mode-hook))

(defun ada-newline ()
  "Start new line and indent to current tab stop."
  (interactive)
  (setq cc (current-indentation))
  (newline)
  (indent-to cc)
  )

(defun ada-tab ()
  "Indent to next tab stop."
  (interactive)
  (indent-to (* (1+ (/ (current-indentation) ada-indent)) ada-indent)))

(defun ada-case ()
  "Build skeleton case statement, prompting for the <selector-expression>."
  (interactive)
  (insert "case " (read-string "selector-expr: ") " is")
  (ada-newline)
  (ada-tab)
  (insert "when ")
  (ada-newline)
  (backward-delete-char-untabify ada-indent ())
  (insert "end case;")
  (end-of-line 0)
  (ada-tab))

(defun ada-declare ()
  "Build skeleton declare block, prompting for the block name."
  (interactive)
  (let ((name (read-string "Name: ")))
    (insert name " : declare")
    (ada-newline)
    (ada-newline)
    (insert "begin")
    (ada-newline)
    (ada-newline)
    (insert "end " name ";")
    (end-of-line 0)
    (ada-tab)))


(defun ada-else ()
  "Insert else keyword and indent for next line."
  (interactive)
  (ada-newline)
  (backward-delete-char-untabify ada-indent ())
  (insert "else")
  (ada-newline)
  (ada-tab))

(defun ada-for ()
  "Build skeleton for loop, prompting for the loop parameters."
  (interactive)
  (insert "for " (read-string "loop-var: ") " in ")
  (insert (read-string "first-bound: ") ".." (read-string "second-bound: "))
  (ada-newline)
  (ada-tab)
  (insert "loop")
  (ada-newline)
  (ada-newline)
  (insert "end loop;")
  (end-of-line 0)
  (ada-tab))

(defun ada-function ()
  "Build skeleton function, prompting for function name and paramters."
  (interactive)
  (insert "function ")
  (let ((name (read-string "Name: ")))
    (insert name " (")
    (insert (read-string "Argument list: ") ") return ")
    (insert (read-string "Result type: ") " is")
    (ada-newline)
    (insert "begin")
    (ada-newline)
    (ada-newline)
    (insert "end ")
    (insert name)
    (insert ";")
    (end-of-line 0)
    (ada-tab)))

(defun ada-header ()
  "Insert a comment block containing the program title, author, etc."
  (interactive)
  (insert "-- \n-- Title: ")
  (ada-tab)
  (insert (read-string "Title: "))
  (insert "\n-- Created: ")
  (ada-tab)
  (insert (current-time-string))
  (insert "\n-- Author: ")
  (ada-tab)
  (insert (user-full-name))
  (insert (concat "   <" (user-login-name) "@" (system-name) ">"))
  (insert "\n--")
  (ada-newline))


(defun ada-if ()
  "Insert skeleton if statement, prompting for <boolean-expression>."
  (interactive)
  (insert "if " (read-string "<boolean-expression>: ") " then")
  (ada-newline)
  (ada-newline)
  (insert "end if;")
  (end-of-line 0)
  (ada-tab))

(defun ada-loop ()
  "Insert skeleton loop statement."
  (interactive)
  (insert "loop")
  (ada-newline)
  (ada-newline)
  (insert "end loop;")
  (end-of-line 0)
  (ada-tab))

(defun ada-package-spec ()
  "Build skeleton package specification, prompting for <package-name>."
  (interactive)
  (insert "package ")
  (let ((name (read-string "Name: ")))
    (insert name " is")
    (ada-newline)
    (ada-newline)
    (insert "end " name ";")
    (end-of-line 0)
    (ada-tab)))

(defun ada-package-body ()
  "Build skeleton package body, prompting for <package-name>."
  (interactive)
  (insert "package body ")
  (let ((name (read-string "Name: ")))
    (insert name " is")
    (ada-newline)
    (ada-newline)
    (insert "end " name ";")
    (end-of-line 0)
    (ada-tab)))

(defun ada-procedure ()
  "Build skeleton procedure, prompting for procedure name and parameters."
  (interactive)
  (insert "procedure ")
  (let ((name (read-string "Name: " ))
    args)
    (insert name " (")
    (insert (read-string "Argument list: ") ") is")
    (ada-newline)
    (insert "begin")
    (ada-newline)
    (ada-newline)
    (insert "end ")
    (insert name)
    (insert ";")
    (end-of-line 0)
    (ada-tab)))

(defun ada-with ()
  "Insert with statement, prompting for list of package names."
  (interactive)
  (insert "with ")
  (let ((name (read-string "package-name list: ")))
    (insert name "; use " name ";")
    (ada-newline)))


(defun ada-record ()
  "Insert skeleton record statement."
  (interactive)
  (insert "record")
  (ada-newline)
  (ada-newline)
  (insert "end record;")
  (end-of-line 0)
  (ada-tab))

(defun ada-stdio ()
  "Insert with using commonly desired packages."
  (interactive)
  (insert "with TEXT_IO; use TEXT_IO;")
  (insert "\nwith SEQUENTIAL_IO; use SEQUENTIAL_IO;\n"))

(defun ada-while ()
  "Insert skeleton while loop, prompting for <boolean-expression>."
  (interactive)
  (insert "while ")
  (insert (read-string "<boolean-expression>: "))
  (ada-newline)
  (ada-tab)
  (insert "loop")
  (ada-newline)
  (ada-newline)
  (insert "end loop;")
  (end-of-line 0)
  (ada-tab))

(defun ada-comment ()
  "Insert comment."
  (interactive)
  (insert "--  \n")
  (end-of-line 0))

(defun ada-task-spec ()
  "Insert skeleton for task specification, prompting for task name."
  (interactive)
  (insert "task ")
  (let ((name (read-string "Name: ")))
    (insert name " is ")
    (ada-newline)
    (ada-newline)
    (insert "end " name ";")
    (end-of-line 0)
    (ada-tab)))

(defun ada-task-body ()
  "Insert skeleton for task body, prompting for task name."
  (interactive)
  (insert "task body ")
  (let ((name (read-string "Name: ")))
    (insert name " is ")
    (ada-newline)
    (ada-newline)
    (insert "begin")
    (ada-newline)
    (ada-newline)
    (insert "end " name ";")
    (end-of-line 0)
    (ada-tab)))

;;; Note: Compilation options setup for VERDIX Ada system

(defun ada-compile ()
  "Compile ada program."
  (interactive)
  (setq modulename (buffer-name))
  (compile (concat "ada " modulename)))

(defun ada-link ()
  "Link previously compiled programs."
  (interactive)
  (setq modulename (buffer-name))
  (compile (concat "a.ld " (substring modulename 0 -2))))

(defun ada-toggle ()
  "Toggle between body and specification files for the program."
  ;;; assumes specification file has name of form: nameS.a
  ;;; and body file has name of form: nameB.a
  (interactive)
  (cond ((string-equal (substring (buffer-name) -3) "S.a")
     (find-file-other-window
       (concat (substring (buffer-name) 0 -3) "B.a")))
    ((string-equal (substring (buffer-name) -3) "B.a")
     (find-file-other-window
       (concat (substring (buffer-name) 0 -3)  "S.a")))))