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