1 ;; gpr-skel.el --- Extension to gpr-mode for inserting statement skeletons -*- lexical-binding:t -*-
3 ;; Copyright (C) 2013-2015 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 `gpr-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 gpr-wisi parser
33 ;; likes, and handle repeated names nicely.
42 ;;;;; user variables, example skeletons intended to be overwritten
45 "Major mode for editing GNAT project files in Emacs."
48 (defcustom gpr-skel-initial-string "{header}\n{project}"
49 "String to insert in empty buffer.
50 This could end in a token recognized by `gpr-skel-expand'."
54 (define-skeleton gpr-skel-user-restricted
55 "Example copyright/license skeleton, with automatic year and owner."
57 "-- Copyright (C) " (format-time-string "%Y ") user-full-name " All Rights Reserved.\n"
60 (define-skeleton gpr-skel-gpl
61 "Example copyright/license skeleton, with automatic year and owner, GPLv3."
63 "-- Copyright (C) " (format-time-string "%Y ") user-full-name " All Rights Reserved.\n"
65 "-- This program is free software; you can redistribute it and/or\n"
66 "-- modify it under terms of the GNU General Public License as\n"
67 "-- published by the Free Software Foundation; either version 3, or (at\n"
68 "-- your option) any later version. This program is distributed in the\n"
69 "-- hope that it will be useful, but WITHOUT ANY WARRANTY; without even\n"
70 "-- the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR\n"
71 "-- PURPOSE. See the GNU General Public License for more details. You\n"
72 "-- should have received a copy of the GNU General Public License\n"
73 "-- distributed with this program; see file COPYING. If not, write to\n"
74 "-- the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,\n"
75 "-- MA 02110-1335, USA.\n"
78 ;;;;; Gpr skeletons (alphabetical)
80 (define-skeleton gpr-skel-case
81 "Insert case statement."
87 (define-skeleton gpr-skel-header
88 "Insert a file header comment, with automatic copyright year and prompt for copyright owner/license.
89 Each user will probably want to override this."
95 "{copyright_license}\n"
98 (define-skeleton gpr-skel-package
99 "Insert a package with name from `str'."
101 "package " str " is\n"
105 (define-skeleton gpr-skel-project
106 "Insert a project with name from `str'."
108 "project " str " is\n"
112 ;;;;; skeleton extensions
114 ;; FIXME: code below should be in skeleton.el
116 (defvar-local skeleton-token-alist nil
117 "Symbol giving skeleton token alist of elements (STRING ELEMENT).
118 See `skeleton-expand'.
119 STRING must be a symbol in the current syntax, and is normally
120 the first keyword in the skeleton. All strings must be
121 lowercase; `skeleton-expand' converts user inputs.
124 - a skeleton, which is inserted
125 - an alist of (string . skeleton). User is prompted with `completing-read', selected skeleton is inserted. ")
127 (defun skeleton-add-skeleton (token skel alist &optional where)
128 "Add an element (TOKEN . SKEL) to ALIST by side-effect.
129 If WHERE is nil, prepend to ALIST; otherwise, prepend to sublist
132 (setf alist (cons (cons token skel) alist))
133 (setf (cdr (assoc where alist))
134 (cons (cons token skel) (cdr (assoc where alist))))
137 (defvar skeleton-test-input nil
138 "When non-nil, bypasses prompt in alist token expansions - used for unit testing.")
140 (defun skeleton-build-prompt (alist count)
141 "Build a prompt from the keys of the ALIST.
142 The prompt consists of the first COUNT keys from the alist, separated by `|', with
143 trailing `...' if there are more keys."
144 (if (>= count (length alist))
145 (concat (mapconcat 'car alist " | ") " : ")
146 (let ((alist-1 (butlast alist (- (length alist) count))))
147 (concat (mapconcat 'car alist-1 " | ") " | ... : "))
150 (defun skeleton-expand (&optional name)
151 "Expand the token or placeholder before point to a skeleton, as defined by `skeleton-token-alist'.
152 A token is a symbol in the current syntax.
153 A placeholder is a symbol enclosed in generic comment delimiters.
154 If the word before point is not in `skeleton-token-alist', assume
155 it is a name, and use the word before that as the token."
158 ;; Skip trailing space, newline, and placeholder delimiter.
159 ;; Standard comment end included for languages where that is newline.
160 (skip-syntax-backward " !>")
162 ;; include punctuation here, in case is is an identifier, to allow Gpr.Text_IO
163 (let* ((end (prog1 (point) (skip-syntax-backward "w_.")))
164 (token (downcase (buffer-substring-no-properties (point) end)))
165 (skel (assoc-string token (symbol-value skeleton-token-alist)))
170 (when (listp (cdr skel))
171 (let* ((alist (cdr skel))
172 (prompt (skeleton-build-prompt alist 4)))
173 (setq skel (assoc-string
174 (or skeleton-test-input
175 (completing-read prompt alist))
177 (setq skeleton-test-input nil) ;; don't reuse input on recursive call
180 ;; delete placeholder delimiters around token, token, and
181 ;; name. point is currently before token.
182 (skip-syntax-backward "!")
186 (skip-syntax-forward "!w_")
188 (skip-syntax-forward " ")
189 (skip-syntax-forward "w_."))
191 (funcall (cdr skel) name)
194 ;; word in point .. end is not a token; assume it is a name
196 ;; avoid infinite recursion
198 ;; Do this now, because skeleton insert won't.
200 ;; We didn't do it above, because we don't want to adjust case
201 ;; on tokens and placeholders.
202 ;; FIXME: hook for Ada case adjust
204 (setq token (buffer-substring-no-properties (point) end))
206 (skeleton-expand token)
210 (error "undefined skeleton token: %s" name))
213 (defun skeleton-hippie-try (old)
214 "For `hippie-expand-try-functions-list'. OLD is ignored."
216 ;; hippie is asking us to try the "next" completion; we don't have one
219 (undo-len (if (sequencep pending-undo-list) (length pending-undo-list) 0)))
226 ;; undo hook action if any
227 (unless (= undo-len (if (sequencep pending-undo-list) (length pending-undo-list) 0))
234 (defun skeleton-next-placeholder ()
235 "Move point forward to start of next placeholder."
237 (skip-syntax-forward "^!"))
239 (defun skeleton-prev-placeholder ()
240 "Move point forward to start of next placeholder."
242 (skip-syntax-backward "^!"))
246 ;;;;; token alist, setup
248 (defconst gpr-skel-token-alist
249 '(("case" . gpr-skel-case)
251 ("GPL" . gpr-skel-gpl)
252 ("restricted" . gpr-skel-user-restricted))
253 ("header" . gpr-skel-header)
254 ("package" . gpr-skel-package)
255 ("project" . gpr-skel-project))
256 "For skeleton-token-alist")
258 (defun gpr-skel-setup ()
259 "Setup a buffer gpr-skel."
260 (setq skeleton-token-alist 'gpr-skel-token-alist)
261 (add-hook 'skeleton-end-hook 'gpr-indent-statement nil t)
262 (when (and gpr-skel-initial-string
264 (insert gpr-skel-initial-string))
267 (provide 'gpr-skeletons)
270 (setq gpr-expand #'skeleton-expand)
272 (add-hook 'gpr-mode-hook #'gpr-skel-setup)