code.delx.au - gnu-emacs/blob - lisp/progmodes/ada-stmt.el

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