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 ;;;;; Ada skeletons (alphabetical)
114 (define-skeleton ada-skel-accept
115 "Insert accept statement with name from `str'."
117 "accept " str " do\n"
120 (define-skeleton ada-skel-case
121 "Insert case statement."
127 (define-skeleton ada-skel-declare
128 "Insert a block statement with an optional name (from `str')."
137 (define-skeleton ada-skel-entry
138 "Insert entry statement with name from `str'."
140 "entry " str " when " _ "\n"
145 (define-skeleton ada-skel-for
146 "Insert a for loop statement with an optional name (from `str')."
150 "end loop " str | -1 ";")
152 (define-skeleton ada-skel-function-body
153 "Insert a function body with name from `str'."
155 "function " str " return \n"
161 (define-skeleton ada-skel-function-spec
162 "Insert a function type specification with name from `str'."
164 "function " str " return ;")
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."
174 "{copyright_license}\n"
177 (define-skeleton ada-skel-if
178 "Insert an if statement."
185 (define-skeleton ada-skel-loop
186 "Insert a loop statement with an optional name (from `str')."
190 "exit " str | -1 " when " _ ";\n"
191 "end loop " str | -1 ";")
193 (define-skeleton ada-skel-package-body
194 "Insert a package body with name from `str'."
196 "package body " str " is\n"
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."
205 "package " str " is\n"
210 (define-skeleton ada-skel-procedure-body
211 "Insert a procedure body with name from `str'."
213 "procedure " str "\n"
219 (define-skeleton ada-skel-procedure-spec
220 "Insert a procedure type specification with name from `str'."
222 "procedure " str ";")
224 (define-skeleton ada-skel-protected-body
225 "Insert a protected body with name from `str'."
227 "protected body " str " is\n"
231 (define-skeleton ada-skel-protected-spec
232 "Insert a protected type specification with name from `str'."
234 "protected type " str " is\n"
239 (define-skeleton ada-skel-record
240 "Insert a record type declaration with a type name from `str'."
242 "type " str " is record\n"
246 (define-skeleton ada-skel-return
247 "Insert an extended return statement."
253 (define-skeleton ada-skel-select
254 "Insert a select statement."
261 (define-skeleton ada-skel-task-body
262 "Insert a task body with name from `str'."
264 "task body " str "\n"
270 (define-skeleton ada-skel-task-spec
271 "Insert a task specification with name from `str'."
277 (define-skeleton ada-skel-while
278 "Insert a while loop statement with an optional name (from `str')."
282 "end loop " str | -1 ";")
284 (define-skeleton ada-skel-with-use
285 "Insert with and use context clauses with name from `str'."
287 "with " str "; use " str ";")
289 ;;;;; token alist, other functions
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)
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)
302 ("body" . ada-skel-function-body)
303 ("spec" . ada-skel-function-spec))
304 ("header" . ada-skel-header)
306 ("loop" . ada-skel-loop)
308 ("body" . ada-skel-package-body)
309 ("spec" . ada-skel-package-spec))
311 ("body" . ada-skel-procedure-body)
312 ("spec" . ada-skel-procedure-spec))
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)
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.
330 - a skeleton, which is inserted
331 - an alist of (string . skeleton). User is prompted with `completing-read', selected skeleton is inserted. ")
333 (defvar ada-skel-test-input nil
334 "When non-nil, bypasses prompt in alist token expansions - used for unit testing.")
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 " | ") " | ... : "))
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."
354 ;; Skip trailing space, newline, and placeholder delimiter.
355 ;; Standard comment end included for languages where that is newline.
356 (skip-syntax-backward " !>")
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))
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))
373 (setq ada-skel-test-input nil) ;; don't reuse input on recursive call
376 ;; delete placeholder delimiters around token, token, and
377 ;; name. point is currently before token.
378 (skip-syntax-backward "!")
382 (skip-syntax-forward "!w_")
384 (skip-syntax-forward " ")
385 (skip-syntax-forward "w_."))
387 (funcall (cdr skel) name)
390 ;; word in point .. end is not a token; assume it is a name
392 ;; avoid infinite recursion
394 ;; Do this now, because skeleton insert won't.
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))
401 (ada-skel-expand token)
405 (error "undefined skeleton token: %s" name))
408 (defun ada-skel-hippie-try (old)
409 "For `hippie-expand-try-functions-list'. OLD is ignored."
411 ;; hippie is asking us to try the "next" completion; we don't have one
414 (undo-len (if (eq 't pending-undo-list)
416 (length pending-undo-list))))
423 ;; undo hook action if any
424 (unless (or (eq 't pending-undo-list)
425 (= undo-len (length pending-undo-list)))
432 (defun ada-skel-setup ()
433 "Setup a buffer for ada-skel."
434 (add-hook 'skeleton-end-hook 'ada-indent-statement nil t)
435 (when (and ada-skel-initial-string
437 (insert ada-skel-initial-string))
440 (provide 'ada-skeletons)
443 (setq ada-expand 'ada-skel-expand)
445 (add-hook 'ada-mode-hook 'ada-skel-setup)
447 ;;; ada-skel.el ends here