1;;; ada.el --- Ada editing support package in GNUlisp. v1.0 2 3;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc. 4 5;; Author: Vincent Broman <broman@bugs.nosc.mil> 6;; Keywords: languages 7 8;; This file is part of GNU Emacs. 9 10;; GNU Emacs is free software; you can redistribute it and/or modify 11;; it under the terms of the GNU General Public License as published by 12;; the Free Software Foundation; either version 2, or (at your option) 13;; any later version. 14 15;; GNU Emacs is distributed in the hope that it will be useful, 16;; but WITHOUT ANY WARRANTY; without even the implied warranty of 17;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 18;; GNU General Public License for more details. 19 20;; You should have received a copy of the GNU General Public License 21;; along with GNU Emacs; see the file COPYING. If not, write to 22;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA. 23 24;;; Commentary: 25 26;; Created May 1987. 27;; (borrows heavily from Mick Jordan's Modula-2 package for GNU, 28;; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.) 29 30;;; Code: 31 32(setq auto-mode-alist (cons (cons "\\.ada$" 'ada-mode) auto-mode-alist)) 33 34(defvar ada-mode-syntax-table nil 35 "Syntax table in use in Ada-mode buffers.") 36 37(let ((table (make-syntax-table))) 38 (modify-syntax-entry ?_ "_" table) 39 (modify-syntax-entry ?\# "_" table) 40 (modify-syntax-entry ?\( "()" table) 41 (modify-syntax-entry ?\) ")(" table) 42 (modify-syntax-entry ?$ "." table) 43 (modify-syntax-entry ?* "." table) 44 (modify-syntax-entry ?/ "." table) 45 (modify-syntax-entry ?+ "." table) 46 (modify-syntax-entry ?- "." table) 47 (modify-syntax-entry ?= "." table) 48 (modify-syntax-entry ?\& "." table) 49 (modify-syntax-entry ?\| "." table) 50 (modify-syntax-entry ?< "." table) 51 (modify-syntax-entry ?> "." table) 52 (modify-syntax-entry ?\[ "." table) 53 (modify-syntax-entry ?\] "." table) 54 (modify-syntax-entry ?\{ "." table) 55 (modify-syntax-entry ?\} "." table) 56 (modify-syntax-entry ?. "." table) 57 (modify-syntax-entry ?\\ "." table) 58 (modify-syntax-entry ?: "." table) 59 (modify-syntax-entry ?\; "." table) 60 (modify-syntax-entry ?\' "." table) 61 (modify-syntax-entry ?\" "\"" table) 62 (setq ada-mode-syntax-table table)) 63 64(defvar ada-mode-map nil 65 "Keymap used in Ada mode.") 66 67(let ((map (make-sparse-keymap))) 68 (define-key map "\C-m" 'ada-newline) 69 (define-key map "\C-?" 'backward-delete-char-untabify) 70 (define-key map "\C-i" 'ada-tab) 71 (define-key map "\C-c\C-i" 'ada-untab) 72 (define-key map "\C-c<" 'ada-backward-to-same-indent) 73 (define-key map "\C-c>" 'ada-forward-to-same-indent) 74 (define-key map "\C-ch" 'ada-header) 75 (define-key map "\C-c(" 'ada-paired-parens) 76 (define-key map "\C-c-" 'ada-inline-comment) 77 (define-key map "\C-c\C-a" 'ada-array) 78 (define-key map "\C-cb" 'ada-exception-block) 79 (define-key map "\C-cd" 'ada-declare-block) 80 (define-key map "\C-c\C-e" 'ada-exception) 81 (define-key map "\C-cc" 'ada-case) 82 (define-key map "\C-c\C-k" 'ada-package-spec) 83 (define-key map "\C-ck" 'ada-package-body) 84 (define-key map "\C-c\C-p" 'ada-procedure-spec) 85 (define-key map "\C-cp" 'ada-subprogram-body) 86 (define-key map "\C-c\C-f" 'ada-function-spec) 87 (define-key map "\C-cf" 'ada-for-loop) 88 (define-key map "\C-cl" 'ada-loop) 89 (define-key map "\C-ci" 'ada-if) 90 (define-key map "\C-cI" 'ada-elsif) 91 (define-key map "\C-ce" 'ada-else) 92 (define-key map "\C-c\C-v" 'ada-private) 93 (define-key map "\C-c\C-r" 'ada-record) 94 (define-key map "\C-c\C-s" 'ada-subtype) 95 (define-key map "\C-cs" 'ada-separate) 96 (define-key map "\C-c\C-t" 'ada-type) 97 (define-key map "\C-ct" 'ada-tabsize) 98;; (define-key map "\C-c\C-u" 'ada-use) 99;; (define-key map "\C-c\C-w" 'ada-with) 100 (define-key map "\C-cw" 'ada-while-loop) 101 (define-key map "\C-c\C-w" 'ada-when) 102 (define-key map "\C-cx" 'ada-exit) 103 (define-key map "\C-cC" 'ada-compile) 104 (define-key map "\C-cB" 'ada-bind) 105 (define-key map "\C-cE" 'ada-find-listing) 106 (define-key map "\C-cL" 'ada-library-name) 107 (define-key map "\C-cO" 'ada-options-for-bind) 108 (setq ada-mode-map map)) 109 110(defvar ada-indent 4 "*Value is the number of columns to indent in Ada-Mode.") 111 112(defun ada-mode () 113"This is a mode intended to support program development in Ada. 114Most control constructs and declarations of Ada can be inserted in the buffer 115by typing Control-C followed by a character mnemonic for the construct. 116 117\\<ada-mode-map>\\[ada-array] array \\[ada-exception-block] exception block 118\\[ada-exception] exception \\[ada-declare-block] declare block 119\\[ada-package-spec] package spec \\[ada-package-body] package body 120\\[ada-procedure-spec] procedure spec \\[ada-subprogram-body] proc/func body 121\\[ada-function-spec] func spec \\[ada-for-loop] for loop 122 \\[ada-if] if 123 \\[ada-elsif] elsif 124 \\[ada-else] else 125\\[ada-private] private \\[ada-loop] loop 126\\[ada-record] record \\[ada-case] case 127\\[ada-subtype] subtype \\[ada-separate] separate 128\\[ada-type] type \\[ada-tabsize] tab spacing for indents 129\\[ada-when] when \\[ada-while] while 130 \\[ada-exit] exit 131\\[ada-paired-parens] paired parens \\[ada-inline-comment] inline comment 132 \\[ada-header] header spec 133\\[ada-compile] compile \\[ada-bind] bind 134\\[ada-find-listing] find error list 135\\[ada-library-name] name library \\[ada-options-for-bind] options for bind 136 137\\[ada-backward-to-same-indent] and \\[ada-forward-to-same-indent] move backward and forward respectively to the next line 138having the same (or lesser) level of indentation. 139 140Variable `ada-indent' controls the number of spaces for indent/undent." 141 (interactive) 142 (kill-all-local-variables) 143 (use-local-map ada-mode-map) 144 (setq major-mode 'ada-mode) 145 (setq mode-name "Ada") 146 (make-local-variable 'comment-column) 147 (setq comment-column 41) 148 (make-local-variable 'end-comment-column) 149 (setq end-comment-column 72) 150 (set-syntax-table ada-mode-syntax-table) 151 (make-local-variable 'paragraph-start) 152 (setq paragraph-start (concat "^$\\|" page-delimiter)) 153 (make-local-variable 'paragraph-separate) 154 (setq paragraph-separate paragraph-start) 155 (make-local-variable 'paragraph-ignore-fill-prefix) 156 (setq paragraph-ignore-fill-prefix t) 157; (make-local-variable 'indent-line-function) 158; (setq indent-line-function 'c-indent-line) 159 (make-local-variable 'require-final-newline) 160 (setq require-final-newline t) 161 (make-local-variable 'comment-start) 162 (setq comment-start "--") 163 (make-local-variable 'comment-end) 164 (setq comment-end "") 165 (make-local-variable 'comment-column) 166 (setq comment-column 41) 167 (make-local-variable 'comment-start-skip) 168 (setq comment-start-skip "--+ *") 169 (make-local-variable 'comment-indent-function) 170 (setq comment-indent-function 'c-comment-indent) 171 (make-local-variable 'parse-sexp-ignore-comments) 172 (setq parse-sexp-ignore-comments t) 173 (run-hooks 'ada-mode-hook)) 174 175(defun ada-tabsize (s) 176 "Changes spacing used for indentation. 177The prefix argument is used as the new spacing." 178 (interactive "p") 179 (setq ada-indent s)) 180 181(defun ada-newline () 182 "Start new line and indent to current tab stop." 183 (interactive) 184 (let ((ada-cc (current-indentation))) 185 (newline) 186 (indent-to ada-cc))) 187 188(defun ada-tab () 189 "Indent to next tab stop." 190 (interactive) 191 (indent-to (* (1+ (/ (current-indentation) ada-indent)) ada-indent))) 192 193(defun ada-untab () 194 "Delete backwards to previous tab stop." 195 (interactive) 196 (backward-delete-char-untabify ada-indent nil)) 197 198(defun ada-go-to-this-indent (step indent-level) 199 "Move point repeatedly by STEP lines until the current line has 200given INDENT-LEVEL or less, or the start or end of the buffer is reached. 201Ignore blank lines, statement labels and block or loop names." 202 (while (and 203 (zerop (forward-line step)) 204 (or (looking-at "^[ ]*$") 205 (looking-at "^[ ]*--") 206 (looking-at "^<<[A-Za-z0-9_]+>>") 207 (looking-at "^[A-Za-z0-9_]+:") 208 (> (current-indentation) indent-level))) 209 nil)) 210 211(defun ada-backward-to-same-indent () 212 "Move point backwards to nearest line with same indentation or less. 213If not found, point is left at the top of the buffer." 214 (interactive) 215 (ada-go-to-this-indent -1 (current-indentation)) 216 (back-to-indentation)) 217 218(defun ada-forward-to-same-indent () 219 "Move point forwards to nearest line with same indentation or less. 220If not found, point is left at the start of the last line in the buffer." 221 (interactive) 222 (ada-go-to-this-indent 1 (current-indentation)) 223 (back-to-indentation)) 224 225(defun ada-array () 226 "Insert array type definition. Uses the minibuffer to prompt 227for component type and index subtypes." 228 (interactive) 229 (insert "array ()") 230 (backward-char) 231 (insert (read-string "index subtype[s]: ")) 232 (end-of-line) 233 (insert " of ;") 234 (backward-char) 235 (insert (read-string "component-type: ")) 236 (end-of-line)) 237 238(defun ada-case () 239 "Build skeleton case statement. 240Uses the minibuffer to prompt for the selector expression. 241Also builds the first when clause." 242 (interactive) 243 (insert "case ") 244 (insert (read-string "selector expression: ") " is") 245 (ada-newline) 246 (ada-newline) 247 (insert "end case;") 248 (end-of-line 0) 249 (ada-tab) 250 (ada-tab) 251 (ada-when)) 252 253(defun ada-declare-block () 254 "Insert a block with a declare part. 255Indent for the first declaration." 256 (interactive) 257 (let ((ada-block-name (read-string "[block name]: "))) 258 (insert "declare") 259 (cond 260 ( (not (string-equal ada-block-name "")) 261 (beginning-of-line) 262 (open-line 1) 263 (insert ada-block-name ":") 264 (next-line 1) 265 (end-of-line))) 266 (ada-newline) 267 (ada-newline) 268 (insert "begin") 269 (ada-newline) 270 (ada-newline) 271 (if (string-equal ada-block-name "") 272 (insert "end;") 273 (insert "end " ada-block-name ";")) 274 ) 275 (end-of-line -2) 276 (ada-tab)) 277 278(defun ada-exception-block () 279 "Insert a block with an exception part. 280Indent for the first line of code." 281 (interactive) 282 (let ((block-name (read-string "[block name]: "))) 283 (insert "begin") 284 (cond 285 ( (not (string-equal block-name "")) 286 (beginning-of-line) 287 (open-line 1) 288 (insert block-name ":") 289 (next-line 1) 290 (end-of-line))) 291 (ada-newline) 292 (ada-newline) 293 (insert "exception") 294 (ada-newline) 295 (ada-newline) 296 (cond 297 ( (string-equal block-name "") 298 (insert "end;")) 299 ( t 300 (insert "end " block-name ";"))) 301 ) 302 (end-of-line -2) 303 (ada-tab)) 304 305(defun ada-exception () 306 "Insert an indented exception part into a block." 307 (interactive) 308 (ada-untab) 309 (insert "exception") 310 (ada-newline) 311 (ada-tab)) 312 313(defun ada-else () 314 "Add an else clause inside an if-then-end-if clause." 315 (interactive) 316 (ada-untab) 317 (insert "else") 318 (ada-newline) 319 (ada-tab)) 320 321(defun ada-exit () 322 "Insert an exit statement, prompting for loop name and condition." 323 (interactive) 324 (insert "exit") 325 (let ((ada-loop-name (read-string "[name of loop to exit]: "))) 326 (if (not (string-equal ada-loop-name "")) (insert " " ada-loop-name))) 327 (let ((ada-exit-condition (read-string "[exit condition]: "))) 328 (if (not (string-equal ada-exit-condition "")) 329 (if (string-match "^ *[Ww][Hh][Ee][Nn] +" ada-exit-condition) 330 (insert " " ada-exit-condition) 331 (insert " when " ada-exit-condition)))) 332 (insert ";")) 333 334(defun ada-when () 335 "Start a case statement alternative with a when clause." 336 (interactive) 337 (ada-untab) ; we were indented in code for the last alternative. 338 (insert "when ") 339 (insert (read-string "'|'-delimited choice list: ") " =>") 340 (ada-newline) 341 (ada-tab)) 342 343(defun ada-for-loop () 344 "Build a skeleton for-loop statement, prompting for the loop parameters." 345 (interactive) 346 (insert "for ") 347 (let* ((ada-loop-name (read-string "[loop name]: ")) 348 (ada-loop-is-named (not (string-equal ada-loop-name "")))) 349 (if ada-loop-is-named 350 (progn 351 (beginning-of-line) 352 (open-line 1) 353 (insert ada-loop-name ":") 354 (next-line 1) 355 (end-of-line 1))) 356 (insert (read-string "loop variable: ") " in ") 357 (insert (read-string "range: ") " loop") 358 (ada-newline) 359 (ada-newline) 360 (insert "end loop") 361 (if ada-loop-is-named (insert " " ada-loop-name)) 362 (insert ";")) 363 (end-of-line 0) 364 (ada-tab)) 365 366(defun ada-header () 367 "Insert a comment block containing the module title, author, etc." 368 (interactive) 369 (insert "--\n-- Title: \t") 370 (insert (read-string "Title: ")) 371 (insert "\n-- Created:\t" (current-time-string)) 372 (insert "\n-- Author: \t" (user-full-name)) 373 (insert "\n--\t\t<" (user-login-name) "@" (system-name) ">\n--\n")) 374 375(defun ada-if () 376 "Insert skeleton if statment, prompting for a boolean-expression." 377 (interactive) 378 (insert "if ") 379 (insert (read-string "condition: ") " then") 380 (ada-newline) 381 (ada-newline) 382 (insert "end if;") 383 (end-of-line 0) 384 (ada-tab)) 385 386(defun ada-elsif () 387 "Add an elsif clause to an if statement, prompting for the boolean-expression." 388 (interactive) 389 (ada-untab) 390 (insert "elsif ") 391 (insert (read-string "condition: ") " then") 392 (ada-newline) 393 (ada-tab)) 394 395(defun ada-loop () 396 "Insert a skeleton loop statement. The exit statement is added by hand." 397 (interactive) 398 (insert "loop ") 399 (let* ((ada-loop-name (read-string "[loop name]: ")) 400 (ada-loop-is-named (not (string-equal ada-loop-name "")))) 401 (if ada-loop-is-named 402 (progn 403 (beginning-of-line) 404 (open-line 1) 405 (insert ada-loop-name ":") 406 (forward-line 1) 407 (end-of-line 1))) 408 (ada-newline) 409 (ada-newline) 410 (insert "end loop") 411 (if ada-loop-is-named (insert " " ada-loop-name)) 412 (insert ";")) 413 (end-of-line 0) 414 (ada-tab)) 415 416(defun ada-package-spec () 417 "Insert a skeleton package specification." 418 (interactive) 419 (insert "package ") 420 (let ((ada-package-name (read-string "package name: " ))) 421 (insert ada-package-name " is") 422 (ada-newline) 423 (ada-newline) 424 (insert "end " ada-package-name ";") 425 (end-of-line 0) 426 (ada-tab))) 427 428(defun ada-package-body () 429 "Insert a skeleton package body -- includes a begin statement." 430 (interactive) 431 (insert "package body ") 432 (let ((ada-package-name (read-string "package name: " ))) 433 (insert ada-package-name " is") 434 (ada-newline) 435 (ada-newline) 436 (insert "begin") 437 (ada-newline) 438 (insert "end " ada-package-name ";") 439 (end-of-line -1) 440 (ada-tab))) 441 442(defun ada-private () 443 "Undent and start a private section of a package spec. Reindent." 444 (interactive) 445 (ada-untab) 446 (insert "private") 447 (ada-newline) 448 (ada-tab)) 449 450(defun ada-get-arg-list () 451 "Read from the user a procedure or function argument list. 452Add parens unless arguments absent, and insert into buffer. 453Individual arguments are arranged vertically if entered one at a time. 454Arguments ending with `;' are presumed single and stacked." 455 (insert " (") 456 (let ((ada-arg-indent (current-column)) 457 (ada-args (read-string "[arguments]: "))) 458 (if (string-equal ada-args "") 459 (backward-delete-char 2) 460 (progn 461 (while (string-match ";$" ada-args) 462 (insert ada-args) 463 (newline) 464 (indent-to ada-arg-indent) 465 (setq ada-args (read-string "next argument: "))) 466 (insert ada-args ")"))))) 467 468(defun ada-function-spec () 469 "Insert a function specification. Prompts for name and arguments." 470 (interactive) 471 (insert "function ") 472 (insert (read-string "function name: ")) 473 (ada-get-arg-list) 474 (insert " return ") 475 (insert (read-string "result type: "))) 476 477(defun ada-procedure-spec () 478 "Insert a procedure specification, prompting for its name and arguments." 479 (interactive) 480 (insert "procedure ") 481 (insert (read-string "procedure name: " )) 482 (ada-get-arg-list)) 483 484(defun get-ada-subprogram-name () 485 "Return (without moving point or mark) a pair whose CAR is the name of 486the function or procedure whose spec immediately precedes point, and whose 487CDR is the column number where the procedure/function keyword was found." 488 (save-excursion 489 (let ((ada-proc-indent 0)) 490 (if (re-search-backward 491 ;;;; Unfortunately, comments are not ignored in this string search. 492 "[PpFf][RrUu][OoNn][Cc][EeTt][DdIi][UuOo][RrNn]" nil t) 493 (if (or (looking-at "\\<[Pp][Rr][Oo][Cc][Ee][Dd][Uu][Rr][Ee]\\>") 494 (looking-at "\\<[Ff][Uu][Nn][Cc][Tt][Ii][Oo][Nn]\\>")) 495 (progn 496 (setq ada-proc-indent (current-column)) 497 (forward-word 2) 498 (let ((p2 (point))) 499 (forward-word -1) 500 (cons (buffer-substring (point) p2) ada-proc-indent))) 501 (get-ada-subprogram-name)) 502 (cons "NAME?" ada-proc-indent))))) 503 504(defun ada-subprogram-body () 505 "Insert frame for subprogram body. 506Invoke right after `ada-function-spec' or `ada-procedure-spec'." 507 (interactive) 508 (insert " is") 509 (let ((ada-subprogram-name-col (get-ada-subprogram-name))) 510 (newline) 511 (indent-to (cdr ada-subprogram-name-col)) 512 (ada-newline) 513 (insert "begin") 514 (ada-newline) 515 (ada-newline) 516 (insert "end " (car ada-subprogram-name-col) ";")) 517 (end-of-line -2) 518 (ada-tab)) 519 520(defun ada-separate () 521 "Finish a body stub with `is separate'." 522 (interactive) 523 (insert " is") 524 (ada-newline) 525 (ada-tab) 526 (insert "separate;") 527 (ada-newline) 528 (ada-untab)) 529 530;(defun ada-with () 531; "Inserts a with clause, prompting for the list of units depended upon." 532; (interactive) 533; (insert "with ") 534; (insert (read-string "list of units depended upon: ") ";")) 535; 536;(defun ada-use () 537; "Inserts a use clause, prompting for the list of packages used." 538; (interactive) 539; (insert "use ") 540; (insert (read-string "list of packages to use: ") ";")) 541 542(defun ada-record () 543 "Insert a skeleton record type declaration." 544 (interactive) 545 (insert "record") 546 (ada-newline) 547 (ada-newline) 548 (insert "end record;") 549 (end-of-line 0) 550 (ada-tab)) 551 552(defun ada-subtype () 553 "Start insertion of a subtype declaration, prompting for the subtype name." 554 (interactive) 555 (insert "subtype " (read-string "subtype name: ") " is ;") 556 (backward-char) 557 (message "insert subtype indication.")) 558 559(defun ada-type () 560 "Start insertion of a type declaration, prompting for the type name." 561 (interactive) 562 (insert "type " (read-string "type name: ")) 563 (let ((disc-part (read-string "discriminant specs: "))) 564 (if (not (string-equal disc-part "")) 565 (insert "(" disc-part ")"))) 566 (insert " is ") 567 (message "insert type definition.")) 568 569(defun ada-while-loop () 570 (interactive) 571 (insert "while ") 572 (let* ((ada-loop-name (read-string "loop name: ")) 573 (ada-loop-is-named (not (string-equal ada-loop-name "")))) 574 (if ada-loop-is-named 575 (progn 576 (beginning-of-line) 577 (open-line 1) 578 (insert ada-loop-name ":") 579 (next-line 1) 580 (end-of-line 1))) 581 (insert (read-string "entry condition: ") " loop") 582 (ada-newline) 583 (ada-newline) 584 (insert "end loop") 585 (if ada-loop-is-named (insert " " ada-loop-name)) 586 (insert ";")) 587 (end-of-line 0) 588 (ada-tab)) 589 590(defun ada-paired-parens () 591 "Insert a pair of round parentheses, placing point between them." 592 (interactive) 593 (insert "()") 594 (backward-char)) 595 596(defun ada-inline-comment () 597 "Start a comment after the end of the line, indented at least 598`comment-column' spaces. If starting after `end-comment-column', 599start a new line." 600 (interactive) 601 (end-of-line) 602 (if (> (current-column) end-comment-column) (newline)) 603 (if (< (current-column) comment-column) (indent-to comment-column)) 604 (insert " -- ")) 605 606(defun ada-display-comment () 607"Inserts three comment lines, making a display comment." 608 (interactive) 609 (insert "--\n-- \n--") 610 (end-of-line 0)) 611 612;; Much of this is specific to Ada-Ed 613 614(defvar ada-lib-dir-name "lib" "*Current Ada program library directory.") 615(defvar ada-bind-opts "" "*Options to supply for binding.") 616 617(defun ada-library-name (ada-lib-name) 618 "Specify name of Ada library directory for later compilations." 619 (interactive "DName of Ada library directory: ") 620 (setq ada-lib-dir-name ada-lib-name)) 621 622(defun ada-options-for-bind () 623 "Specify options, such as -m and -i, needed for `ada-bind'." 624 (setq ada-bind-opts (read-string "-m and -i options for `ada-bind': "))) 625 626(defun ada-compile (arg) 627 "Save the current buffer and compile it into the current program library. 628Initialize the library if a prefix arg is given." 629 (interactive "P") 630 (let* ((ada-init (if (null arg) "" "-n ")) 631 (ada-source-file (buffer-name))) 632 (compile 633 (concat "adacomp " ada-init "-l " ada-lib-dir-name " " ada-source-file)))) 634 635(defun ada-find-listing () 636 "Find listing file for ada source in current buffer, using other window." 637 (interactive) 638 (find-file-other-window (concat (substring (buffer-name) 0 -4) ".lis")) 639 (search-forward "*** ERROR")) 640 641(defun ada-bind () 642 "Bind the current program library, using the current binding options." 643 (interactive) 644 (compile (concat "adabind " ada-bind-opts " " ada-lib-dir-name))) 645 646;;; ada.el ends here 647