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