Relay-Version: version B 2.10 5/3/83; site utzoo.UUCP
Path: utzoo!mnetor!uunet!seismo!husc6!rutgers!ames!ucbcad!ucbvax!UNO.BITNET!JNTCS
From: JNTCS@UNO.BITNET
Newsgroups: comp.emacs
Subject: (insert) vs abbrev-mode, Ada-mode
Message-ID: <8707300021.AA03669@ucbvax.Berkeley.EDU>
Date: Wed, 29-Jul-87 20:07:00 EDT
Article-I.D.: ucbvax.8707300021.AA03669
Posted: Wed Jul 29 20:07:00 1987
Date-Received: Sat, 1-Aug-87 01:00:49 EDT
Sender: daemon@ucbvax.BERKELEY.EDU
Distribution: world
Organization: The ARPA Internet
Lines: 457

The Ada/Modula-2/Pascal modes use the insert and read-string functions to
input and insert parts of their language constructs into the buffer (e.g.,
(insert "if " (read-string "<boolean-expression>: ") " then") as one example).
I like to use abbrev-mode to define reasonable identifiers via abbreviations.
The read-string function shows the abbreviations in the mini-buffer (as I think
I would like it), but during the insert into the buffer there is a random
expansion of the abbrevs (the last one on the line only seems to be expanded).
This results in things like "if sdfsf < STRING_DELIMITER_FIELD_RANGE" (where
sdfsf is an abbrev) (no snide remarks about the obvious language choice made
for the example).

Obviously ada-mode doesn't want to know anything about abbrev-mode.  It seems
to me that abbrev-mode needs to provide its own definition of insert?  It
would be possible for someone to do an expand-region-abbrevs, but that isn't
the right thing to do.  Has anyone been through this problem in other modes?

(I am using gnuEmacs both version 17.VMS and 18.44 .)

I've done a bunch of diddling with ada-mode, and a copy of my version is
appended.  I wanted the keyword of the construct to appear in the buffer before
the prompt for information, so I split (for example) the if above into several
inserts.  I also added more (overloaded on C-c CAPITAL-LETTER, groan) routines.
The only thing that still bothers me is the handling of comments.  M-; and
C-M-j don't interact properly.  But, for what it's worth...

James N. Thomas                         alias list: Jim, Nothead
Computer Science                        BITNET: JNTCS@UNO.BITNET
university of new orleans               maBell: (504) 286-6754
New Orleans LA 70148                    motto: Aloha!

-------------------- <cut-here> --------------------
; 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>
; Ada version modified by Jim Thomas <JNTCS@UNO.BITNET>


(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 ?\_ "w" 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-cE" 'ada-elsif)
    (define-key map "\C-cx" 'ada-exception)
    (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-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-cW" 'ada-when)
    (define-key map "\C-c\C-w" 'ada-with)
    (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 2 "*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/E elsif  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 W when
  Control-c x exception     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 ")
  (insert (read-string "selector-expr: ") " is")
  (ada-newline)
  (ada-tab)
  (insert "when ")
  (insert (read-string "choice: ") " =>")
  (ada-newline)
  (ada-newline)
  (backward-delete-char-untabify ada-indent ())
  (insert "end case;")
  (end-of-line 0)
  (ada-tab))

(defun ada-comment ()
  "Insert comment."
  (interactive)
  (insert "-- "))

(defun ada-declare ()
  "Build skeleton declare block, prompting for the block name."
  (interactive)
  (let ((name (read-string "Name: ")))
    (cond ((equal name "") nil)
          (t (insert name " : ")))
    (insert "declare")
    (ada-newline)
    (ada-newline)
    (insert "begin")
    (ada-newline)
    (ada-newline)
    (insert "end")
    (cond ((equal name "") nil)
          (t (insert " " name)))
    (insert ";")
    (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-elsif ()
  "Insert elsif keyword, prompt for expression, and indent for next line."
  (interactive)
  (ada-newline)
  (backward-delete-char-untabify ada-indent ())
  (insert "elsif ")
  (insert (read-string "<boolean-expression>: "))
  (ada-newline)
  (insert "then")
  (ada-newline)
  (ada-tab))

(defun ada-exception ()
  "Build skeleton exception handler, prompting for first <exception-choice>."
  (interactive)
  (insert "exception")
  (ada-newline)
  (ada-tab)
  (insert "when ")
  (insert (read-string "exception-choice: ") " =>")
  (ada-newline)
  (ada-tab))

(defun ada-for ()
  "Build skeleton for loop, prompting for the loop parameters."
  (interactive)
  (insert "for ")
  (insert (read-string "loop-var: ") " in ")
  (insert (read-string "first-bound or range: "))
  (let ((second-bound (read-string "second-bound: ")))
    (cond ((equal second-bound "") nil)
          (t (insert " .. " second-bound))))
  (ada-newline)
  (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)
    (ada-newline)
    (insert "begin")
    (ada-newline)
    (ada-newline)
    (insert "end " name ";")
    (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 ")
  (insert (read-string "<boolean-expression>: "))
  (ada-newline)
  (insert "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)
    (let ((arg-list (read-string "Argument list: ")))
      (cond ((equal arg-list "") nil)
            (t (insert " (" arg-list  ")"))))
    (insert " is")
    (ada-newline)
    (ada-newline)
    (insert "begin")
    (ada-newline)
    (ada-newline)
    (insert "end " name ";")
    (end-of-line 0)
    (ada-tab)))

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

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

(defun ada-when ()
  "Insert when clause on next line, prompting for <choice>."
  (interactive)
  (ada-newline)
  (backward-delete-char-untabify ada-indent ())
  (insert "when ")
  (insert (read-string "choice: ") " =>")
  (ada-newline)
  (ada-tab))

(defun ada-while ()
  "Insert skeleton while loop, prompting for <boolean-expression>."
  (interactive)
  (insert "while ")
  (insert (read-string "<boolean-expression>: "))
  (ada-newline)
  (insert "loop")
  (ada-newline)
  (ada-newline)
  (insert "end loop;")
  (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)))

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