code.delx.au - gnu-emacs-elpa/blob - packages/ada-mode/ada-skel.el

   1 ;;; ada-skel.el --- an extension to Ada mode for inserting statement skeletons
   2
   3 ;; Copyright (C) 1987, 1993, 1994, 1996-2014  Free Software Foundation, Inc.
   4
   5 ;; Authors: Stephen Leake <stephen_leake@stephe-leake.org>
   6
   7 ;; This file is part of GNU Emacs.
   8
   9 ;; GNU Emacs is free software: you can redistribute it and/or modify
  10 ;; it under the terms of the GNU General Public License as published by
  11 ;; the Free Software Foundation, either version 3 of the License, or
  12 ;; (at your option) any later version.
  13
  14 ;; GNU Emacs is distributed in the hope that it will be useful,
  15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 ;; GNU General Public License for more details.
  18
  19 ;; You should have received a copy of the GNU General Public License
  20 ;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
  21
  22 ;;; Design:
  23 ;;
  24 ;; The primary user command is `ada-skel-expand', which inserts the
  25 ;; skeleton associated with the previous word (possibly skipping a
  26 ;; name).
  27 ;;
  28 ;; We don't define skeletons that prompt for most of the content; it
  29 ;; is easier just to type in the buffer.
  30 ;;
  31 ;; These skeletons are not intended to teach a novice the language,
  32 ;; just to make it easier to write code that the ada-wisi parser
  33 ;; likes, and handle repeated names nicely.
  34
  35 ;;; History:
  36
  37 ;; Created May 1987.
  38 ;; Original version from V. Bowman as in ada.el of Emacs-18
  39 ;; (borrowed heavily from Mick Jordan's Modula-2 package for GNU,
  40 ;; as modified by Peter Robinson, Michael Schmidt, and Tom Perrine.)
  41 ;;
  42 ;; Sep 1993. Daniel Pfeiffer <pfeiffer@cict.fr> (DP)
  43 ;; Introduced statement.el for smaller code and user configurability.
  44 ;;
  45 ;; Nov 1993. Rolf Ebert <ebert@enpc.fr> (RE) Moved the
  46 ;; skeleton generation into this separate file. The code still is
  47 ;; essentially written by DP
  48 ;;
  49 ;; Adapted Jun 1994. Markus Heritsch
  50 ;; <Markus.Heritsch@studbox.uni-stuttgart.de> (MH)
  51 ;; added menu bar support for templates
  52 ;;
  53 ;; 1994/12/02  Christian Egli <cegli@hcsd.hac.com>
  54 ;; General cleanup and bug fixes.
  55 ;;
  56 ;; 1995/12/20  John Hutchison <hutchiso@epi.syr.ge.com>
  57 ;; made it work with skeleton.el from Emacs-19.30. Several
  58 ;; enhancements and bug fixes.
  59 ;;
  60 ;; Sep 2013 Stephen Leake renamed to ada-skel (to match skeleton.el),
  61 ;; complete re-write: added ada-skel-alist (to get some of the
  62 ;; functionality of the sadly missed Else package). Simplified
  63 ;; skeletons; just make it easier to work with the ada-wisi parser,
  64 ;; don't try to teach syntax.
  65
  66 (require 'skeleton nil t)
  67
  68 ;;;;; user variables, example skeletons intended to be overwritten
  69
  70 (defcustom ada-skel-initial-string
  71   "{header}
  72 --  Emacs note: Type C-c C-e with point after the above placeholder
  73 --
  74 --  This text was inserted by ada-skel-initial-string;
  75 --  M-x customize-variable <RET> ada-skel-initial-string <RET>
  76 --  (info \"(ada-mode)Statement skeletons\")"
  77   "*String to insert in empty buffer.
  78 This could end in a token recognized by `ada-skel-expand'."
  79   :type 'string
  80   :group 'ada
  81   :safe 'stringp)
  82
  83 (define-skeleton ada-skel-user-restricted
  84   "Example copyright/license skeleton, with automatic year and owner."
  85   ()
  86   "--  Copyright (C) " (format-time-string "%Y ") user-full-name " All Rights Reserved.\n"
  87   "\n"
  88   "pragma License (Restricted);\n"
  89 )
  90
  91 (define-skeleton ada-skel-gpl
  92   "Example copyright/license skeleton, with automatic year and owner, GPLv3."
  93   ()
  94   "--  Copyright (C) " (format-time-string "%Y ") user-full-name " All Rights Reserved.\n"
  95   "--\n"
  96   "--  This program is free software; you can redistribute it and/or\n"
  97   "--  modify it under terms of the GNU General Public License as\n"
  98   "--  published by the Free Software Foundation; either version 3, or (at\n"
  99   "--  your option) any later version. This program is distributed in the\n"
 100   "--  hope that it will be useful, but WITHOUT ANY WARRANTY; without even\n"
 101   "--  the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR\n"
 102   "--  PURPOSE. See the GNU General Public License for more details. You\n"
 103   "--  should have received a copy of the GNU General Public License\n"
 104   "--  distributed with this program; see file COPYING. If not, write to\n"
 105   "--  the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,\n"
 106   "--  MA 02110-1335, USA.\n"
 107   "\n"
 108   "pragma License (GPL);\n"
 109
 110 )
 111
 112 ;;;;; Ada skeletons (alphabetical)
 113
 114 (define-skeleton ada-skel-accept
 115   "Insert accept statement with name from `str'."
 116   ()
 117   "accept " str " do\n"
 118   "end " str ";")
 119
 120 (define-skeleton ada-skel-case
 121   "Insert case statement."
 122   ()
 123   "case " str " is\n"
 124   "when " _ "=>\n"
 125   "end case;")
 126
 127 (define-skeleton ada-skel-declare
 128   "Insert a block statement with an optional name (from `str')."
 129   ()
 130   str & ":\n"
 131   "declare\n"
 132   _
 133   "begin\n"
 134   "exception\n"
 135   "end " str | -1 ?\;)
 136
 137 (define-skeleton ada-skel-entry
 138   "Insert entry statement with name from `str'."
 139   ()
 140   "entry " str " when " _ "\n"
 141   "is\n"
 142   "begin\n"
 143   "end " str ";")
 144
 145 (define-skeleton ada-skel-for
 146   "Insert a for loop statement with an optional name (from `str')."
 147   ()
 148   str & " :\n"
 149   "for " _ " loop\n"
 150   "end loop " str | -1 ";")
 151
 152 (define-skeleton ada-skel-function-body
 153   "Insert a function body with name from `str'."
 154   ()
 155   "function " str " return \n"
 156   "is\n"
 157   "begin\n"
 158   _
 159   "end " str ";" >)
 160
 161 (define-skeleton ada-skel-function-spec
 162   "Insert a function type specification with name from `str'."
 163   ()
 164   "function " str " return ;")
 165
 166 (define-skeleton ada-skel-header
 167   "Insert a file header comment, with automatic copyright year and prompt for copyright owner/license.
 168 Each user will probably want to override this."
 169   ()
 170   "--  Abstract :\n"
 171   "--\n"
 172   "--  " _ "\n"
 173   "--\n"
 174   "{copyright_license}\n"
 175   )
 176
 177 (define-skeleton ada-skel-if
 178   "Insert an if statement."
 179   ()
 180   "if " _ " then\n"
 181   "elsif  then\n"
 182   "else\n"
 183   "end if;")
 184
 185 (define-skeleton ada-skel-loop
 186   "Insert a loop statement with an optional name (from `str')."
 187   ()
 188   str & ":\n"
 189   "loop\n"
 190   "exit " str | -1 " when " _ ";\n"
 191   "end loop " str | -1 ";")
 192
 193 (define-skeleton ada-skel-package-body
 194   "Insert a package body with name from `str'."
 195   ()
 196   "package body " str " is\n"
 197   _
 198   "begin\n"
 199   "end " str ";")
 200
 201 (define-skeleton ada-skel-package-spec
 202   "Insert a package specification with name from `str'.
 203 See `ada-find-other-file' to create library level package body from spec."
 204   ()
 205   "package " str " is\n"
 206   _
 207   "private\n"
 208   "end " str ";")
 209
 210 (define-skeleton ada-skel-procedure-body
 211   "Insert a procedure body with name from `str'."
 212   ()
 213   "procedure " str "\n"
 214   "is\n"
 215   "begin\n"
 216   _
 217   "end " str ";")
 218
 219 (define-skeleton ada-skel-procedure-spec
 220   "Insert a procedure type specification with name from `str'."
 221   ()
 222   "procedure " str ";")
 223
 224 (define-skeleton ada-skel-protected-body
 225   "Insert a protected body with name from `str'."
 226   ()
 227   "protected body " str " is\n"
 228   _
 229   "end " str ";")
 230
 231 (define-skeleton ada-skel-protected-spec
 232   "Insert a protected type specification with name from `str'."
 233   ()
 234   "protected type " str " is\n"
 235   _
 236   "private\n"
 237   "end " str ";")
 238
 239 (define-skeleton ada-skel-record
 240   "Insert a record type declaration with a type name from `str'."
 241   ()
 242   "type " str " is record\n"
 243   _
 244   "end record;")
 245
 246 (define-skeleton ada-skel-return
 247   "Insert an extended return statement."
 248   ()
 249   "return" _ "\n"
 250   "do\n"
 251   "end return;")
 252
 253 (define-skeleton ada-skel-select
 254   "Insert a select statement."
 255   ()
 256   "select\n"
 257   _
 258   "else\n"
 259   "end select;")
 260
 261 (define-skeleton ada-skel-task-body
 262   "Insert a task body with name from `str'."
 263   ()
 264   "task body " str "\n"
 265   "is\n"
 266   _
 267   "begin\n"
 268   "end " str ";")
 269
 270 (define-skeleton ada-skel-task-spec
 271   "Insert a task specification with name from `str'."
 272   ()
 273   "task " str " is\n"
 274   _
 275   "end " str ";")
 276
 277 (define-skeleton ada-skel-while
 278   "Insert a while loop statement with an optional name (from `str')."
 279   ()
 280   str & ":\n"
 281   "while " _ " loop\n"
 282   "end loop " str | -1 ";")
 283
 284 (define-skeleton ada-skel-with-use
 285   "Insert with and use context clauses with name from `str'."
 286   ()
 287   "with " str "; use " str ";")
 288
 289 ;;;;; token alist, other functions
 290
 291 (defconst ada-skel-token-alist
 292   '(("accept" . ada-skel-accept)
 293     ("begin" . ada-skel-declare) ;; easy enough to delete the declare
 294     ("case" . ada-skel-case)
 295     ("copyright_license"
 296      ("GPL" . ada-skel-gpl)
 297      ("restricted" . ada-skel-user-restricted))
 298     ("declare" . ada-skel-declare)
 299     ("entry" . ada-skel-entry)
 300     ("for" . ada-skel-for)
 301     ("function"
 302      ("body" . ada-skel-function-body)
 303      ("spec" . ada-skel-function-spec))
 304     ("header" . ada-skel-header)
 305     ("if" . ada-skel-if)
 306     ("loop" . ada-skel-loop)
 307     ("package"
 308      ("body" . ada-skel-package-body)
 309      ("spec" . ada-skel-package-spec))
 310     ("procedure"
 311      ("body" . ada-skel-procedure-body)
 312      ("spec" . ada-skel-procedure-spec))
 313     ("protected"
 314      ("body" . ada-skel-protected-body)
 315      ("spec" . ada-skel-protected-spec))
 316     ("record" . ada-skel-record)
 317     ("return" . ada-skel-return)
 318     ("select" . ada-skel-select)
 319     ("task"
 320      ("body" . ada-skel-task-body)
 321      ("spec" . ada-skel-task-spec))
 322     ("while" . ada-skel-while)
 323     ("with" . ada-skel-with-use))
 324   "alist of elements (STRING ELEMENT). See `ada-skel-expand'.
 325 STRING must be a symbol in the current syntax, and is normally
 326 the first Ada keyword in the skeleton. All strings must be
 327 lowercase; `ada-skel-expand' converts user inputs.
 328
 329 ELEMENT may be:
 330 - a skeleton, which is inserted
 331 - an alist of (string . skeleton). User is prompted with `completing-read', selected skeleton is inserted. ")
 332
 333 (defvar ada-skel-test-input nil
 334   "When non-nil, bypasses prompt in alist token expansions - used for unit testing.")
 335
 336 (defun ada-skel-build-prompt (alist count)
 337   "Build a prompt from the keys of the ALIST.
 338 The prompt consists of the first COUNT keys from the alist, separated by `|', with
 339 trailing `...' if there are more keys."
 340   (if (>= count (length alist))
 341       (concat (mapconcat 'car alist " | ") " : ")
 342     (let ((alist-1 (butlast alist (- (length alist) count))))
 343       (concat (mapconcat 'car alist-1 " | ") " | ... : "))
 344   ))
 345
 346 (defun ada-skel-expand (&optional name)
 347   "Expand the token or placeholder before point to a skeleton, as defined by `ada-skel-token-alist'.
 348 A token is a symbol in the current syntax.
 349 A placeholder is a symbol enclosed in generic comment delimiters.
 350 If the word before point is not in `ada-skel-token-alist', assume
 351 it is a name, and use the word before that as the token."
 352   (interactive "*")
 353
 354   ;; Skip trailing space, newline, and placeholder delimiter.
 355   ;; Standard comment end included for languages where that is newline.
 356   (skip-syntax-backward " !>")
 357
 358   ;; include punctuation here, in case is is an identifier, to allow Ada.Text_IO
 359   (let* ((end (prog1 (point) (skip-syntax-backward "w_.")))
 360          (token (downcase (buffer-substring-no-properties (point) end)))
 361          (skel (assoc-string token ada-skel-token-alist))
 362          (handled nil))
 363
 364     (if skel
 365         (progn
 366           (when (listp (cdr skel))
 367             (let* ((alist (cdr skel))
 368                    (prompt (ada-skel-build-prompt alist 4)))
 369               (setq skel (assoc-string
 370                           (or ada-skel-test-input
 371                               (completing-read prompt alist))
 372                           alist))
 373               (setq ada-skel-test-input nil) ;; don't reuse input on recursive call
 374               ))
 375
 376           ;; delete placeholder delimiters around token, token, and
 377           ;; name. point is currently before token.
 378           (skip-syntax-backward "!")
 379           (delete-region
 380            (point)
 381            (progn
 382              (skip-syntax-forward "!w_")
 383              (when name
 384                (skip-syntax-forward " ")
 385                (skip-syntax-forward "w_."))
 386              (point)))
 387           (funcall (cdr skel) name)
 388           (setq handled t))
 389
 390       ;; word in point .. end is not a token; assume it is a name
 391       (when (not name)
 392         ;; avoid infinite recursion
 393
 394         ;; Do this now, because skeleton insert won't.
 395         ;;
 396         ;; We didn't do it above, because we don't want to adjust case
 397         ;; on tokens and placeholders.
 398         (save-excursion (ada-case-adjust-region (point) end))
 399         (setq token (buffer-substring-no-properties (point) end))
 400
 401         (ada-skel-expand token)
 402         (setq handled t)))
 403
 404     (when (not handled)
 405       (error "undefined skeleton token: %s" name))
 406     ))
 407
 408 (defun ada-skel-hippie-try (old)
 409   "For `hippie-expand-try-functions-list'. OLD is ignored."
 410   (if old
 411       ;; hippie is asking us to try the "next" completion; we don't have one
 412       nil
 413     (let ((pos (point))
 414           (undo-len (if (eq 't pending-undo-list)
 415                         0
 416                       (length pending-undo-list))))
 417       (undo-boundary)
 418       (condition-case nil
 419           (progn
 420             (ada-skel-expand)
 421             t)
 422         ('error
 423          ;; undo hook action if any
 424          (unless (or (eq 't pending-undo-list)
 425                      (= undo-len (length pending-undo-list)))
 426            (undo))
 427
 428          ;; undo motion
 429          (goto-char pos)
 430          nil)))))
 431
 432 (defun ada-skel-next-placeholder ()
 433   "Move point to after next placeholder."
 434   (skip-syntax-forward "^!")
 435   (skip-syntax-forward "w!"))
 436
 437 (defun ada-skel-prev-placeholder ()
 438   "Move point to after previous placeholder."
 439   (skip-syntax-backward "^!"))
 440
 441 (defun ada-skel-setup ()
 442   "Setup a buffer for ada-skel."
 443   (add-hook 'skeleton-end-hook 'ada-indent-statement nil t)
 444   (when (and ada-skel-initial-string
 445              (= (buffer-size) 0))
 446     (insert ada-skel-initial-string))
 447   )
 448
 449 (provide 'ada-skeletons)
 450 (provide 'ada-skel)
 451
 452 (setq ada-expand 'ada-skel-expand)
 453 (setq ada-next-placeholder 'ada-skel-next-placeholder)
 454 (setq ada-prev-placeholder 'ada-skel-prev-placeholder)
 455
 456 (add-hook 'ada-mode-hook 'ada-skel-setup)
 457
 458 ;;; ada-skel.el ends here