1 ;;; ada-skel.el --- an extension to Ada mode for inserting statement skeletons
3 ;; Copyright (C) 1987, 1993, 1994, 1996-2013 Free Software Foundation, Inc.
5 ;; Authors: Stephen Leake <stephen_leake@stephe-leake.org>
7 ;; This file is part of GNU Emacs.
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.
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.
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/>.
24 ;; The primary user command is `ada-skel-expand', which inserts the
25 ;; skeleton associated with the previous word (possibly skipping a
28 ;; We don't define skeletons that prompt for most of the content; it
29 ;; is easier just to type in the buffer.
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.
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.)
42 ;; Sep 1993. Daniel Pfeiffer <pfeiffer@cict.fr> (DP)
43 ;; Introduced statement.el for smaller code and user configurability.
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
49 ;; Adapted Jun 1994. Markus Heritsch
50 ;; <Markus.Heritsch@studbox.uni-stuttgart.de> (MH)
51 ;; added menu bar support for templates
53 ;; 1994/12/02 Christian Egli <cegli@hcsd.hac.com>
54 ;; General cleanup and bug fixes.
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.
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.
66 (require 'skeleton nil t)
68 ;;;;; user variables, example skeletons intended to be overwritten
70 (defcustom ada-skel-initial-string "header"
71 "*String to insert in empty buffer.
72 This could end in a token recognized by `ada-skel-expand'."
77 (define-skeleton ada-skel-user-restricted
78 "Example copyright/license skeleton, with automatic year and owner."
80 "-- Copyright (C) " (format-time-string "%Y ") user-full-name " All Rights Reserved.\n"
82 "pragma License (Restricted);\n"
85 (define-skeleton ada-skel-gpl
86 "Example copyright/license skeleton, with automatic year and owner, GPLv3."
88 "-- Copyright (C) " (format-time-string "%Y ") user-full-name " All Rights Reserved.\n"
90 "-- This program is free software; you can redistribute it and/or\n"
91 "-- modify it under terms of the GNU General Public License as\n"
92 "-- published by the Free Software Foundation; either version 3, or (at\n"
93 "-- your option) any later version. This program is distributed in the\n"
94 "-- hope that it will be useful, but WITHOUT ANY WARRANTY; without even\n"
95 "-- the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR\n"
96 "-- PURPOSE. See the GNU General Public License for more details. You\n"
97 "-- should have received a copy of the GNU General Public License\n"
98 "-- distributed with this program; see file COPYING. If not, write to\n"
99 "-- the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,\n"
100 "-- MA 02110-1335, USA.\n"
102 "pragma License (GPL);\n"
106 ;;;;; Ada skeletons (alphabetical)
108 (define-skeleton ada-skel-accept
109 "Insert accept statement with name from `str'."
111 "accept " str " do\n"
114 (define-skeleton ada-skel-case
115 "Insert case statement."
121 (define-skeleton ada-skel-declare
122 "Insert a block statement with an optional name (from `str')."
131 (define-skeleton ada-skel-entry
132 "Insert entry statement with name from `str'."
134 "entry " str " when " _ "\n"
139 (define-skeleton ada-skel-for
140 "Insert a for loop statement with an optional name (from `str')."
144 "end loop " str | -1 ";")
146 (define-skeleton ada-skel-function-body
147 "Insert a function body with name from `str'."
149 "function " str " return \n"
155 (define-skeleton ada-skel-function-spec
156 "Insert a function type specification with name from `str'."
158 "function " str " return ;")
160 (define-skeleton ada-skel-header
161 "Insert a file header comment, with automatic copyright year and prompt for copyright owner/license.
162 Each user will probably want to override this."
168 "{copyright_license}\n"
171 (define-skeleton ada-skel-if
172 "Insert an if statement."
179 (define-skeleton ada-skel-loop
180 "Insert a loop statement with an optional name (from `str')."
184 "exit " str | -1 " when " _ ";\n"
185 "end loop " str | -1 ";")
187 (define-skeleton ada-skel-package-body
188 "Insert a package body with name from `str'."
190 "package body " str " is\n"
195 (define-skeleton ada-skel-package-spec
196 "Insert a package specification with name from `str'.
197 See `ada-find-other-file' to create library level package body from spec."
199 "package " str " is\n"
204 (define-skeleton ada-skel-procedure-body
205 "Insert a procedure body with name from `str'."
207 "procedure " str "\n"
213 (define-skeleton ada-skel-procedure-spec
214 "Insert a procedure type specification with name from `str'."
216 "procedure " str ";")
218 (define-skeleton ada-skel-protected-body
219 "Insert a protected body with name from `str'."
221 "protected body " str " is\n"
225 (define-skeleton ada-skel-protected-spec
226 "Insert a protected type specification with name from `str'."
228 "protected type " str " is\n"
233 (define-skeleton ada-skel-record
234 "Insert a record type declaration with a type name from `str'."
236 "type " str " is record\n"
240 (define-skeleton ada-skel-return
241 "Insert an extended return statement."
247 (define-skeleton ada-skel-select
248 "Insert a select statement."
255 (define-skeleton ada-skel-task-body
256 "Insert a task body with name from `str'."
258 "task body " str "\n"
264 (define-skeleton ada-skel-task-spec
265 "Insert a task specification with name from `str'."
271 (define-skeleton ada-skel-while
272 "Insert a while loop statement with an optional name (from `str')."
276 "end loop " str | -1 ";")
278 (define-skeleton ada-skel-with-use
279 "Insert with and use context clauses with name from `str'."
281 "with " str "; use " str ";")
283 ;;;;; token alist, other functions
285 (defconst ada-skel-token-alist
286 '(("accept" . ada-skel-accept)
287 ("begin" . ada-skel-declare) ;; easy enough to delete the declare
288 ("case" . ada-skel-case)
290 ("GPL" . ada-skel-gpl)
291 ("restricted" . ada-skel-user-restricted))
292 ("declare" . ada-skel-declare)
293 ("entry" . ada-skel-entry)
294 ("for" . ada-skel-for)
296 ("body" . ada-skel-function-body)
297 ("spec" . ada-skel-function-spec))
298 ("header" . ada-skel-header)
300 ("loop" . ada-skel-loop)
302 ("body" . ada-skel-package-body)
303 ("spec" . ada-skel-package-spec))
305 ("body" . ada-skel-procedure-body)
306 ("spec" . ada-skel-procedure-spec))
308 ("body" . ada-skel-protected-body)
309 ("spec" . ada-skel-protected-spec))
310 ("record" . ada-skel-record)
311 ("return" . ada-skel-return)
312 ("select" . ada-skel-select)
314 ("body" . ada-skel-task-body)
315 ("spec" . ada-skel-task-spec))
316 ("while" . ada-skel-while)
317 ("with" . ada-skel-with-use))
318 "alist of elements (STRING ELEMENT). See `ada-skel-expand'.
319 STRING must be a symbol in the current syntax, and is normally
320 the first Ada keyword in the skeleton. All strings must be
321 lowercase; `ada-skel-expand' converts user inputs.
324 - a skeleton, which is inserted
325 - an alist of (string . skeleton). User is prompted with `completing-read', selected skeleton is inserted. ")
327 (defvar ada-skel-test-input nil
328 "When non-nil, bypasses prompt in alist token expansions - used for unit testing.")
330 (defun ada-skel-build-prompt (alist count)
331 "Build a prompt from the keys of the ALIST.
332 The prompt consists of the first COUNT keys from the alist, separated by `|', with
333 trailing `...' if there are more keys."
334 (if (>= count (length alist))
335 (concat (mapconcat 'car alist " | ") " : ")
336 (let ((alist-1 (butlast alist (- (length alist) count))))
337 (concat (mapconcat 'car alist-1 " | ") " | ... : "))
340 (defun ada-skel-expand (&optional name)
341 "Expand the token or placeholder before point to a skeleton, as defined by `ada-skel-token-alist'.
342 A token is a symbol in the current syntax.
343 A placeholder is a symbol enclosed in generic comment delimiters.
344 If the word before point is not in `ada-skel-token-alist', assume
345 it is a name, and use the word before that as the token."
348 ;; Skip trailing space, newline, and placeholder delimiter.
349 ;; Standard comment end included for languages where that is newline.
350 (skip-syntax-backward " !>")
352 ;; include punctuation here, in case is is an identifier, to allow Ada.Text_IO
353 (let* ((end (prog1 (point) (skip-syntax-backward "w_.")))
354 (token (downcase (buffer-substring-no-properties (point) end)))
355 (skel (assoc-string token ada-skel-token-alist))
360 (when (listp (cdr skel))
361 (let* ((alist (cdr skel))
362 (prompt (ada-skel-build-prompt alist 4)))
363 (setq skel (assoc-string
364 (or ada-skel-test-input
365 (completing-read prompt alist))
367 (setq ada-skel-test-input nil) ;; don't reuse input on recursive call
370 ;; delete placeholder delimiters around token, token, and
371 ;; name. point is currently before token.
372 (skip-syntax-backward "!")
376 (skip-syntax-forward "!w_")
378 (skip-syntax-forward " ")
379 (skip-syntax-forward "w_."))
381 (funcall (cdr skel) name)
384 ;; word in point .. end is not a token; assume it is a name
386 ;; avoid infinite recursion
388 ;; Do this now, because skeleton insert won't.
390 ;; We didn't do it above, because we don't want to adjust case
391 ;; on tokens and placeholders.
392 (save-excursion (ada-case-adjust-region (point) end))
393 (setq token (buffer-substring-no-properties (point) end))
395 (ada-skel-expand token)
399 (error "undefined skeleton token: %s" name))
402 (defun ada-skel-hippie-try (old)
403 "For `hippie-expand-try-functions-list'. OLD is ignored."
405 ;; hippie is asking us to try the "next" completion; we don't have one
414 ;; undo ada-case-adjust, motion
419 (defun ada-skel-setup ()
420 "Setup a buffer ada-skel."
421 (add-hook 'skeleton-end-hook 'ada-indent-statement nil t)
422 (when (and ada-skel-initial-string
424 (insert ada-skel-initial-string))
427 (provide 'ada-skeletons)
430 (setq ada-expand 'ada-skel-expand)
432 (add-hook 'ada-mode-hook 'ada-skel-setup)
434 ;;; ada-skel.el ends here