[comp.emacs] Ada mode for GNU emacs

hmiller@eddie.MIT.EDU (Herbert A. Miller) (05/31/87)

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

kdj@hall.cray.com (Douglas K Johnston) (08/23/88)

We are trying to locate support for an Ada major mode.  Does anyone know
of such a thing?  We are developing using a Sun 3/280 file server and
Sun 3/50 workstations.  Our GNU emacs version is 18.51.

We can be reached via either USENET or ARPANET.  Please either post info
to the net, return mail to me or mail to Terry Greyzck on ARPANET at
  TDG@sc.msc.umn.edu

  Doug Johnston
  Cray Ada Project
  Suite 118
  500 Montezuma
  Santa Fe, NM 87501