lisp/progmodes/ada-stmt.el

   1 ;;; ada-stmt.el --- an extension to Ada mode for inserting statement templates
   2
   3 ;; Copyright (C) 1987, 1993, 1994, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
   4 ;;   2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
   5
   6 ;; Authors: Daniel Pfeiffer, Markus Heritsch, Rolf Ebert <ebert@waporo.muc.de>
   7 ;; Maintainer: Stephen Leake <stephen_leake@stephe-leake.org>
   8 ;; Keywords: languages, ada
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software: you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation, either version 3 of the License, or
  15 ;; (at your option) any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26 ;; This file is now automatically loaded from ada-mode.el, and creates a submenu
  27 ;; in Ada/ on the menu bar.
  28
  29 ;;; History:
  30
  31 ;; Created May 1987.
  32 ;; Original version from V. Bowman as in ada.el of Emacs-18
  33 ;; (borrowed heavily from Mick Jordan's Modula-2 package for GNU,
  34 ;; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.)
  35 ;;
  36 ;; Sep 1993. Daniel Pfeiffer <pfeiffer@cict.fr> (DP)
  37 ;; Introduced statement.el for smaller code and user configurability.
  38 ;;
  39 ;; Nov 1993. Rolf Ebert <ebert@enpc.fr> (RE) Moved the
  40 ;; skeleton generation into this separate file. The code still is
  41 ;; essentially written by DP
  42 ;;
  43 ;; Adapted Jun 1994. Markus Heritsch
  44 ;; <Markus.Heritsch@studbox.uni-stuttgart.de> (MH)
  45 ;; added menu bar support for templates
  46 ;;
  47 ;; 1994/12/02  Christian Egli <cegli@hcsd.hac.com>
  48 ;; General cleanup and bug fixes.
  49 ;;
  50 ;; 1995/12/20  John Hutchison <hutchiso@epi.syr.ge.com>
  51 ;; made it work with skeleton.el from Emacs-19.30. Several
  52 ;; enhancements and bug fixes.
  53
  54 ;; BUGS:
  55 ;;;> I have the following suggestions for the function template: 1) I
  56 ;;;> don't want it automatically assigning it a name for the return variable. I
  57 ;;;> never want it to be called "Result" because that is nondescriptive. If you
  58 ;;;> must define a variable, give me the ability to specify its name.
  59 ;;;>
  60 ;;;> 2) You do not provide a type for variable 'Result'. Its type is the same
  61 ;;;> as the function's return type, which the template knows, so why force me
  62 ;;;> to type it in?
  63 ;;;>
  64
  65 ;;;It would be nice if one could configure such layout details separately
  66 ;;;without patching the LISP code. Maybe the metalanguage used in ada-stmt.el
  67 ;;;could be taken even further, providing the user with some nice syntax
  68 ;;;for describing layout. Then my own hacks would survive the next
  69 ;;;update of the package :-)
  70
  71 \f
  72 ;;; Code:
  73
  74 (require 'skeleton nil t)
  75 (require 'easymenu)
  76 (require 'ada-mode)
  77
  78 (defun ada-func-or-proc-name ()
  79   "Return the name of the current function or procedure."
  80   (save-excursion
  81     (let ((case-fold-search t))
  82       (if (re-search-backward ada-procedure-start-regexp nil t)
  83           (match-string 5)
  84         "NAME?"))))
  85
  86 ;;; ---- statement skeletons ------------------------------------------
  87
  88 (define-skeleton ada-array
  89   "Insert array type definition.
  90 Prompt for component type and index subtypes."
  91   ()
  92   "array (" ("index definition: " str ", " ) -2 ") of " _ ?\;)
  93
  94
  95 (define-skeleton ada-case
  96   "Build skeleton case statement.
  97 Prompt for the selector expression. Also builds the first when clause."
  98   "[selector expression]: "
  99   "case " str " is" \n
 100   > "when " ("discrete choice: " str " | ") -3 " =>" \n
 101   > _ \n
 102   < < "end case;")
 103
 104
 105 (define-skeleton ada-when
 106   "Start a case statement alternative with a when clause."
 107   ()
 108   < "when " ("discrete choice: " str " | ") -3 " =>" \n
 109   >)
 110
 111
 112 (define-skeleton ada-declare-block
 113   "Insert a block with a declare part.
 114 Indent for the first declaration."
 115   "[block name]: "
 116   < str & ?: & \n
 117   > "declare" \n
 118   > _ \n
 119   < "begin" \n
 120   > \n
 121   < "end " str | -1 ?\;)
 122
 123
 124 (define-skeleton ada-exception-block
 125   "Insert a block with an exception part.
 126 Indent for the first line of code."
 127   "[block name]: "
 128   < str & ?: & \n
 129   > "begin" \n
 130   > _ \n
 131   < "exception" \n
 132   > \n
 133   < "end " str | -1 ?\;)
 134
 135
 136 (define-skeleton ada-exception
 137   "Insert an indented exception part into a block."
 138   ()
 139   < "exception" \n
 140   >)
 141
 142
 143 (define-skeleton ada-exit-1
 144   "Insert then exit condition of the exit statement, prompting for condition."
 145   "[exit condition]: "
 146   "when " str | -5)
 147
 148
 149 (define-skeleton ada-exit
 150   "Insert an exit statement, prompting for loop name and condition."
 151   "[name of loop to exit]: "
 152   "exit " str & ?\ (ada-exit-1) | -1 ?\;)
 153
 154 ;;;###autoload
 155 (defun ada-header ()
 156   "Insert a descriptive header at the top of the file."
 157   (interactive "*")
 158   (save-excursion
 159     (goto-char (point-min))
 160     (if (fboundp 'make-header)
 161         (funcall (symbol-function 'make-header))
 162       (ada-header-tmpl))))
 163
 164
 165 (define-skeleton ada-header-tmpl
 166   "Insert a comment block containing the module title, author, etc."
 167   "[Description]: "
 168   "--                              -*- Mode: Ada -*-"
 169   "\n" ada-fill-comment-prefix "Filename        : " (buffer-name)
 170   "\n" ada-fill-comment-prefix "Description     : " str
 171   "\n" ada-fill-comment-prefix "Author          : " (user-full-name)
 172   "\n" ada-fill-comment-prefix "Created On      : " (current-time-string)
 173   "\n" ada-fill-comment-prefix "Last Modified By: ."
 174   "\n" ada-fill-comment-prefix "Last Modified On: ."
 175   "\n" ada-fill-comment-prefix "Update Count    : 0"
 176   "\n" ada-fill-comment-prefix "Status          : Unknown, Use with caution!"
 177   "\n")
 178
 179
 180 (define-skeleton ada-display-comment
 181   "Inserts three comment lines, making a display comment."
 182   ()
 183   "--\n" ada-fill-comment-prefix _ "\n--")
 184
 185
 186 (define-skeleton ada-if
 187   "Insert skeleton if statment, prompting for a boolean-expression."
 188   "[condition]: "
 189   "if " str " then" \n
 190   > _ \n
 191   < "end if;")
 192
 193
 194 (define-skeleton ada-elsif
 195   "Add an elsif clause to an if statement,
 196 prompting for the boolean-expression."
 197   "[condition]: "
 198   < "elsif " str " then" \n
 199   >)
 200
 201
 202 (define-skeleton ada-else
 203   "Add an else clause inside an if-then-end-if clause."
 204   ()
 205   < "else" \n
 206   >)
 207
 208
 209 (define-skeleton ada-loop
 210   "Insert a skeleton loop statement.  The exit statement is added by hand."
 211   "[loop name]: "
 212   < str & ?: & \n
 213   > "loop" \n
 214   > _ \n
 215   < "end loop " str | -1 ?\;)
 216
 217
 218 (define-skeleton ada-for-loop-prompt-variable
 219   "Prompt for the loop variable."
 220   "[loop variable]: "
 221   str)
 222
 223
 224 (define-skeleton ada-for-loop-prompt-range
 225   "Prompt for the loop range."
 226   "[loop range]: "
 227   str)
 228
 229
 230 (define-skeleton ada-for-loop
 231   "Build a skeleton for-loop statement, prompting for the loop parameters."
 232   "[loop name]: "
 233   < str & ?: & \n
 234   > "for "
 235   (ada-for-loop-prompt-variable)
 236   " in "
 237   (ada-for-loop-prompt-range)
 238   " loop" \n
 239   > _ \n
 240   < "end loop " str | -1 ?\;)
 241
 242
 243 (define-skeleton ada-while-loop-prompt-entry-condition
 244   "Prompt for the loop entry condition."
 245   "[entry condition]: "
 246   str)
 247
 248
 249 (define-skeleton ada-while-loop
 250   "Insert a skeleton while loop statement."
 251   "[loop name]: "
 252   < str & ?: & \n
 253   > "while "
 254   (ada-while-loop-prompt-entry-condition)
 255   " loop" \n
 256   > _ \n
 257   < "end loop " str | -1 ?\;)
 258
 259
 260 (define-skeleton ada-package-spec
 261   "Insert a skeleton package specification."
 262   "[package name]: "
 263   "package " str  " is" \n
 264   > _ \n
 265   < "end " str ?\;)
 266
 267
 268 (define-skeleton ada-package-body
 269   "Insert a skeleton package body --  includes a begin statement."
 270   "[package name]: "
 271   "package body " str " is" \n
 272   > _ \n
 273 ;  < "begin" \n
 274   < "end " str ?\;)
 275
 276
 277 (define-skeleton ada-private
 278   "Undent and start a private section of a package spec. Reindent."
 279   ()
 280   < "private" \n
 281   >)
 282
 283
 284 (define-skeleton ada-function-spec-prompt-return
 285   "Prompts for function result type."
 286   "[result type]: "
 287   str)
 288
 289
 290 (define-skeleton ada-function-spec
 291   "Insert a function specification.  Prompts for name and arguments."
 292   "[function name]: "
 293   "function " str
 294   " (" ("[parameter_specification]: " str "; " ) -2 ")"
 295   " return "
 296   (ada-function-spec-prompt-return)
 297   ";" \n )
 298
 299
 300 (define-skeleton ada-procedure-spec
 301   "Insert a procedure specification, prompting for its name and arguments."
 302   "[procedure name]: "
 303   "procedure " str
 304   " (" ("[parameter_specification]: " str "; " ) -2 ")"
 305   ";" \n )
 306
 307
 308 (define-skeleton ada-subprogram-body
 309   "Insert frame for subprogram body.
 310 Invoke right after `ada-function-spec' or `ada-procedure-spec'."
 311   ()
 312   ;; Remove `;' from subprogram decl
 313   (save-excursion
 314     (let ((pos (1+ (point))))
 315       (ada-search-ignore-string-comment ada-subprog-start-re t nil)
 316       (when (ada-search-ignore-string-comment "(" nil pos t 'search-forward)
 317         (backward-char 1)
 318         (forward-sexp 1)))
 319     (if (looking-at ";")
 320         (delete-char 1)))
 321   " is" \n
 322    _ \n
 323    < "begin" \n
 324    \n
 325    < "exception" \n
 326    "when others => null;" \n
 327    < < "end "
 328   (ada-func-or-proc-name)
 329   ";" \n)
 330
 331
 332 (define-skeleton ada-separate
 333   "Finish a body stub with `separate'."
 334   ()
 335   > "separate;" \n
 336   <)
 337
 338
 339 ;(define-skeleton ada-with
 340 ;  "Inserts a with clause, prompting for the list of units depended upon."
 341 ;  "[list of units depended upon]: "
 342 ;  "with " str ?\;)
 343
 344 ;(define-skeleton ada-use
 345 ;  "Inserts a use clause, prompting for the list of packages used."
 346 ;  "[list of packages used]: "
 347 ;  "use " str ?\;)
 348
 349
 350 (define-skeleton ada-record
 351   "Insert a skeleton record type declaration."
 352   ()
 353   "record" \n
 354   > _ \n
 355   < "end record;")
 356
 357
 358 (define-skeleton ada-subtype
 359   "Start insertion of a subtype declaration, prompting for the subtype name."
 360   "[subtype name]: "
 361   "subtype " str " is " _ ?\;
 362   (not (message "insert subtype indication.")))
 363
 364
 365 (define-skeleton ada-type
 366   "Start insertion of a type declaration, prompting for the type name."
 367   "[type name]: "
 368   "type " str ?\(
 369   ("[discriminant specs]: " str " ")
 370   | (backward-delete-char 1) | ?\)
 371   " is "
 372   (not (message "insert type definition.")))
 373
 374
 375 (define-skeleton ada-task-body
 376   "Insert a task body, prompting for the task name."
 377   "[task name]: "
 378   "task body " str " is\n"
 379   "begin\n"
 380   > _ \n
 381   < "end " str ";" )
 382
 383
 384 (define-skeleton ada-task-spec
 385   "Insert a task specification, prompting for the task name."
 386   "[task name]: "
 387   "task " str
 388   " (" ("[discriminant]: " str "; ") ") is\n"
 389   > "entry " _ \n
 390   <"end " str ";" )
 391
 392
 393 (define-skeleton ada-get-param1
 394   "Prompt for arguments and if any enclose them in brackets."
 395   ()
 396   ("[parameter_specification]: " str "; " ) & -2 & ")")
 397
 398
 399 (define-skeleton ada-get-param
 400   "Prompt for arguments and if any enclose them in brackets."
 401   ()
 402   " ("
 403   (ada-get-param1) | -2)
 404
 405
 406 (define-skeleton ada-entry
 407   "Insert a task entry, prompting for the entry name."
 408   "[entry name]: "
 409   "entry " str
 410   (ada-get-param)
 411   ";" \n)
 412
 413
 414 (define-skeleton ada-entry-family-prompt-discriminant
 415   "Insert a entry specification, prompting for the entry name."
 416   "[discriminant name]: "
 417   str)
 418
 419
 420 (define-skeleton ada-entry-family
 421   "Insert a entry specification, prompting for the entry name."
 422   "[entry name]: "
 423   "entry " str
 424   " (" (ada-entry-family-prompt-discriminant) ")"
 425   (ada-get-param)
 426   ";" \n)
 427
 428
 429 (define-skeleton ada-select
 430   "Insert a select block."
 431   ()
 432   "select\n"
 433   > _ \n
 434   < "end select;")
 435
 436
 437 (define-skeleton ada-accept-1
 438   "Insert a condition statement, prompting for the condition name."
 439   "[condition]: "
 440   "when " str | -5 )
 441
 442
 443 (define-skeleton ada-accept-2
 444   "Insert an accept statement, prompting for the name and arguments."
 445   "[accept name]: "
 446   > "accept " str
 447   (ada-get-param)
 448   " do" \n
 449   > _ \n
 450   < "end " str ";" )
 451
 452
 453 (define-skeleton ada-accept
 454   "Insert an accept statement (prompt for condition, name and arguments)."
 455   ()
 456   > (ada-accept-1) & " =>\n"
 457   (ada-accept-2))
 458
 459
 460 (define-skeleton ada-or-accept
 461   "Insert an accept alternative, prompting for the condition name."
 462   ()
 463   < "or\n"
 464   (ada-accept))
 465
 466
 467 (define-skeleton ada-or-delay
 468   "Insert a delay alternative, prompting for the delay value."
 469   "[delay value]: "
 470   < "or\n"
 471   > "delay " str ";")
 472
 473
 474 (define-skeleton ada-or-terminate
 475   "Insert a terminate alternative."
 476   ()
 477   < "or\n"
 478   > "terminate;")
 479
 480
 481 (provide 'ada-stmt)
 482
 483 ;; arch-tag: 94f51555-cc0e-44e5-8865-8788aae8ecd3
 484 ;;; ada-stmt.el ends here