1 ;;; ada-skel.el --- an extension to Ada mode for inserting statement skeletons
3 ;; Copyright (C) 1987, 1993, 1994, 1996-2014 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
72 -- Emacs note: Type C-c C-e with point after the above placeholder
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'."
83 (define-skeleton ada-skel-user-restricted
84 "Example copyright/license skeleton, with automatic year and owner."
86 "-- Copyright (C) " (format-time-string "%Y ") user-full-name " All Rights Reserved.\n"
88 "pragma License (Restricted);\n"
91 (define-skeleton ada-skel-gpl
92 "Example copyright/license skeleton, with automatic year and owner, GPLv3."
94 "-- Copyright (C) " (format-time-string "%Y ") user-full-name " All Rights Reserved.\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"
108 "pragma License (GPL);\n"
112 ;; override ada-mode 4.01 autoloaded functions
113 (define-obsolete-function-alias 'ada-header 'ada-skel-header "24.4"
114 "Insert a descriptive header at the top of the file.")
116 ;;;;; Ada skeletons (alphabetical)
118 (define-skeleton ada-skel-accept
119 "Insert accept statement with name from `str'."
121 "accept " str " do\n"
124 (define-skeleton ada-skel-case
125 "Insert case statement."
131 (define-skeleton ada-skel-declare
132 "Insert a block statement with an optional name (from `str')."
141 (define-skeleton ada-skel-entry
142 "Insert entry statement with name from `str'."
144 "entry " str " when " _ "\n"
149 (define-skeleton ada-skel-for
150 "Insert a for loop statement with an optional name (from `str')."
154 "end loop " str | -1 ";")
156 (define-skeleton ada-skel-function-body
157 "Insert a function body with name from `str'."
159 "function " str " return \n"
165 (define-skeleton ada-skel-function-spec
166 "Insert a function type specification with name from `str'."
168 "function " str " return ;")
170 (define-skeleton ada-skel-header
171 "Insert a file header comment, with automatic copyright year and prompt for copyright owner/license.
172 Each user will probably want to override this."
178 "{copyright_license}\n"
181 (define-skeleton ada-skel-if
182 "Insert an if statement."
189 (define-skeleton ada-skel-loop
190 "Insert a loop statement with an optional name (from `str')."
194 "exit " str | -1 " when " _ ";\n"
195 "end loop " str | -1 ";")
197 (define-skeleton ada-skel-package-body
198 "Insert a package body with name from `str'."
200 "package body " str " is\n"
205 (define-skeleton ada-skel-package-spec
206 "Insert a package specification with name from `str'.
207 See `ada-find-other-file' to create library level package body from spec."
209 "package " str " is\n"
214 (define-skeleton ada-skel-procedure-body
215 "Insert a procedure body with name from `str'."
217 "procedure " str "\n"
223 (define-skeleton ada-skel-procedure-spec
224 "Insert a procedure type specification with name from `str'."
226 "procedure " str ";")
228 (define-skeleton ada-skel-protected-body
229 "Insert a protected body with name from `str'."
231 "protected body " str " is\n"
235 (define-skeleton ada-skel-protected-spec
236 "Insert a protected type specification with name from `str'."
238 "protected type " str " is\n"
243 (define-skeleton ada-skel-record
244 "Insert a record type declaration with a type name from `str'."
246 "type " str " is record\n"
250 (define-skeleton ada-skel-return
251 "Insert an extended return statement."
257 (define-skeleton ada-skel-select
258 "Insert a select statement."
265 (define-skeleton ada-skel-task-body
266 "Insert a task body with name from `str'."
268 "task body " str "\n"
274 (define-skeleton ada-skel-task-spec
275 "Insert a task specification with name from `str'."
281 (define-skeleton ada-skel-while
282 "Insert a while loop statement with an optional name (from `str')."
286 "end loop " str | -1 ";")
288 (define-skeleton ada-skel-with-use
289 "Insert with and use context clauses with name from `str'."
291 "with " str "; use " str ";")
293 ;;;;; token alist, other functions
295 (defconst ada-skel-token-alist
296 '(("accept" . ada-skel-accept)
297 ("begin" . ada-skel-declare) ;; easy enough to delete the declare
298 ("case" . ada-skel-case)
300 ("GPL" . ada-skel-gpl)
301 ("restricted" . ada-skel-user-restricted))
302 ("declare" . ada-skel-declare)
303 ("entry" . ada-skel-entry)
304 ("for" . ada-skel-for)
306 ("body" . ada-skel-function-body)
307 ("spec" . ada-skel-function-spec))
308 ("header" . ada-skel-header)
310 ("loop" . ada-skel-loop)
312 ("body" . ada-skel-package-body)
313 ("spec" . ada-skel-package-spec))
315 ("body" . ada-skel-procedure-body)
316 ("spec" . ada-skel-procedure-spec))
318 ("body" . ada-skel-protected-body)
319 ("spec" . ada-skel-protected-spec))
320 ("record" . ada-skel-record)
321 ("return" . ada-skel-return)
322 ("select" . ada-skel-select)
324 ("body" . ada-skel-task-body)
325 ("spec" . ada-skel-task-spec))
326 ("while" . ada-skel-while)
327 ("with" . ada-skel-with-use))
328 "alist of elements (STRING ELEMENT). See `ada-skel-expand'.
329 STRING must be a symbol in the current syntax, and is normally
330 the first Ada keyword in the skeleton. All strings must be
331 lowercase; `ada-skel-expand' converts user inputs.
334 - a skeleton, which is inserted
335 - an alist of (string . skeleton). User is prompted with `completing-read', selected skeleton is inserted. ")
337 (defvar ada-skel-test-input nil
338 "When non-nil, bypasses prompt in alist token expansions - used for unit testing.")
340 (defun ada-skel-build-prompt (alist count)
341 "Build a prompt from the keys of the ALIST.
342 The prompt consists of the first COUNT keys from the alist, separated by `|', with
343 trailing `...' if there are more keys."
344 (if (>= count (length alist))
345 (concat (mapconcat 'car alist " | ") " : ")
346 (let ((alist-1 (butlast alist (- (length alist) count))))
347 (concat (mapconcat 'car alist-1 " | ") " | ... : "))
350 (defun ada-skel-expand (&optional name)
351 "Expand the token or placeholder before point to a skeleton, as defined by `ada-skel-token-alist'.
352 A token is a symbol in the current syntax.
353 A placeholder is a symbol enclosed in generic comment delimiters.
354 If the word before point is not in `ada-skel-token-alist', assume
355 it is a name, and use the word before that as the token."
358 ;; Skip trailing space, newline, and placeholder delimiter.
359 ;; Standard comment end included for languages where that is newline.
360 (skip-syntax-backward " !>")
362 ;; include punctuation here, in case is is an identifier, to allow Ada.Text_IO
363 (let* ((end (prog1 (point) (skip-syntax-backward "w_.")))
364 (token (downcase (buffer-substring-no-properties (point) end)))
365 (skel (assoc-string token ada-skel-token-alist))
370 (when (listp (cdr skel))
371 (let* ((alist (cdr skel))
372 (prompt (ada-skel-build-prompt alist 4)))
373 (setq skel (assoc-string
374 (or ada-skel-test-input
375 (completing-read prompt alist))
377 (setq ada-skel-test-input nil) ;; don't reuse input on recursive call
380 ;; delete placeholder delimiters around token, token, and
381 ;; name. point is currently before token.
382 (skip-syntax-backward "!")
386 (skip-syntax-forward "!w_")
388 (skip-syntax-forward " ")
389 (skip-syntax-forward "w_."))
391 (funcall (cdr skel) name)
394 ;; word in point .. end is not a token; assume it is a name
396 ;; avoid infinite recursion
398 ;; Do this now, because skeleton insert won't.
400 ;; We didn't do it above, because we don't want to adjust case
401 ;; on tokens and placeholders.
402 (save-excursion (ada-case-adjust-region (point) end))
403 (setq token (buffer-substring-no-properties (point) end))
405 (ada-skel-expand token)
409 (error "undefined skeleton token: %s" name))
412 (defun ada-skel-hippie-try (old)
413 "For `hippie-expand-try-functions-list'. OLD is ignored."
415 ;; hippie is asking us to try the "next" completion; we don't have one
418 (undo-len (if (eq 't pending-undo-list)
420 (length pending-undo-list))))
427 ;; undo hook action if any
428 (unless (or (eq 't pending-undo-list)
429 (= undo-len (length pending-undo-list)))
436 (defun ada-skel-next-placeholder ()
437 "Move point to after next placeholder."
438 (skip-syntax-forward "^!")
439 (skip-syntax-forward "w!"))
441 (defun ada-skel-prev-placeholder ()
442 "Move point to after previous placeholder."
443 (skip-syntax-backward "^!"))
445 (defun ada-skel-setup ()
446 "Setup a buffer for ada-skel."
447 (add-hook 'skeleton-end-hook 'ada-indent-statement nil t)
448 (when (and ada-skel-initial-string
450 (insert ada-skel-initial-string))
453 (provide 'ada-skeletons)
456 (setq ada-expand 'ada-skel-expand)
457 (setq ada-next-placeholder 'ada-skel-next-placeholder)
458 (setq ada-prev-placeholder 'ada-skel-prev-placeholder)
460 (add-hook 'ada-mode-hook 'ada-skel-setup)
462 ;;; ada-skel.el ends here