1 ;;; gpr-skel.el --- an extension to Gpr mode for inserting statement skeletons
3 ;; Copyright (C) 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 `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
44 (defcustom gpr-skel-initial-string "{header}\n{project}"
45 "*String to insert in empty buffer.
46 This could end in a token recognized by `gpr-skel-expand'."
51 (define-skeleton gpr-skel-user-restricted
52 "Example copyright/license skeleton, with automatic year and owner."
54 "-- Copyright (C) " (format-time-string "%Y ") user-full-name " All Rights Reserved.\n"
57 (define-skeleton gpr-skel-gpl
58 "Example copyright/license skeleton, with automatic year and owner, GPLv3."
60 "-- Copyright (C) " (format-time-string "%Y ") user-full-name " All Rights Reserved.\n"
62 "-- This program is free software; you can redistribute it and/or\n"
63 "-- modify it under terms of the GNU General Public License as\n"
64 "-- published by the Free Software Foundation; either version 3, or (at\n"
65 "-- your option) any later version. This program is distributed in the\n"
66 "-- hope that it will be useful, but WITHOUT ANY WARRANTY; without even\n"
67 "-- the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR\n"
68 "-- PURPOSE. See the GNU General Public License for more details. You\n"
69 "-- should have received a copy of the GNU General Public License\n"
70 "-- distributed with this program; see file COPYING. If not, write to\n"
71 "-- the Free Software Foundation, 51 Franklin Street, Suite 500, Boston,\n"
72 "-- MA 02110-1335, USA.\n"
75 ;;;;; Gpr skeletons (alphabetical)
77 (define-skeleton gpr-skel-case
78 "Insert case statement."
84 (define-skeleton gpr-skel-header
85 "Insert a file header comment, with automatic copyright year and prompt for copyright owner/license.
86 Each user will probably want to override this."
92 "{copyright_license}\n"
95 (define-skeleton gpr-skel-package
96 "Insert a package with name from `str'."
98 "package " str " is\n"
102 (define-skeleton gpr-skel-project
103 "Insert a project with name from `str'."
105 "project " str " is\n"
109 ;;;;; skeleton extensions
111 ;; FIXME: code below should be in skeleton.el
113 (defvar-local skeleton-token-alist nil
114 "Symbol giving skeleton token alist of elements (STRING ELEMENT).
115 See `skeleton-expand'.
116 STRING must be a symbol in the current syntax, and is normally
117 the first keyword in the skeleton. All strings must be
118 lowercase; `skeleton-expand' converts user inputs.
121 - a skeleton, which is inserted
122 - an alist of (string . skeleton). User is prompted with `completing-read', selected skeleton is inserted. ")
124 (defun skeleton-add-skeleton (token skel alist &optional where)
125 "Add an element (TOKEN . SKEL) to ALIST by side-effect.
126 If WHERE is nil, prepend to ALIST; otherwise, prepend to sublist
129 (setf alist (cons (cons token skel) alist))
130 (setf (cdr (assoc where alist))
131 (cons (cons token skel) (cdr (assoc where alist))))
134 (defvar skeleton-test-input nil
135 "When non-nil, bypasses prompt in alist token expansions - used for unit testing.")
137 (defun skeleton-build-prompt (alist count)
138 "Build a prompt from the keys of the ALIST.
139 The prompt consists of the first COUNT keys from the alist, separated by `|', with
140 trailing `...' if there are more keys."
141 (if (>= count (length alist))
142 (concat (mapconcat 'car alist " | ") " : ")
143 (let ((alist-1 (butlast alist (- (length alist) count))))
144 (concat (mapconcat 'car alist-1 " | ") " | ... : "))
147 (defun skeleton-expand (&optional name)
148 "Expand the token or placeholder before point to a skeleton, as defined by `skeleton-token-alist'.
149 A token is a symbol in the current syntax.
150 A placeholder is a symbol enclosed in generic comment delimiters.
151 If the word before point is not in `gpr-skel-token-alist', assume
152 it is a name, and use the word before that as the token."
155 ;; Skip trailing space, newline, and placeholder delimiter.
156 ;; Standard comment end included for languages where that is newline.
157 (skip-syntax-backward " !>")
159 ;; include punctuation here, in case is is an identifier, to allow Gpr.Text_IO
160 (let* ((end (prog1 (point) (skip-syntax-backward "w_.")))
161 (token (downcase (buffer-substring-no-properties (point) end)))
162 (skel (assoc-string token (symbol-value skeleton-token-alist)))
167 (when (listp (cdr skel))
168 (let* ((alist (cdr skel))
169 (prompt (skeleton-build-prompt alist 4)))
170 (setq skel (assoc-string
171 (or skeleton-test-input
172 (completing-read prompt alist))
174 (setq skeleton-test-input nil) ;; don't reuse input on recursive call
177 ;; delete placeholder delimiters around token, token, and
178 ;; name. point is currently before token.
179 (skip-syntax-backward "!")
183 (skip-syntax-forward "!w_")
185 (skip-syntax-forward " ")
186 (skip-syntax-forward "w_."))
188 (funcall (cdr skel) name)
191 ;; word in point .. end is not a token; assume it is a name
193 ;; avoid infinite recursion
195 ;; Do this now, because skeleton insert won't.
197 ;; We didn't do it above, because we don't want to adjust case
198 ;; on tokens and placeholders.
199 ;; FIXME: hook for Ada case adjust
201 (setq token (buffer-substring-no-properties (point) end))
203 (skeleton-expand token)
207 (error "undefined skeleton token: %s" name))
210 (defun skeleton-hippie-try (old)
211 "For `hippie-expand-try-functions-list'. OLD is ignored."
213 ;; hippie is asking us to try the "next" completion; we don't have one
222 ;; undo hook action, motion
228 ;;;;; token alist, setup
230 (defconst gpr-skel-token-alist
231 '(("case" . gpr-skel-case)
233 ("GPL" . gpr-skel-gpl)
234 ("restricted" . gpr-skel-user-restricted))
235 ("header" . gpr-skel-header)
236 ("package" . gpr-skel-package)
237 ("project" . gpr-skel-project))
238 "For skeleton-token-alist")
240 (defun gpr-skel-setup ()
241 "Setup a buffer gpr-skel."
242 (setq skeleton-token-alist 'gpr-skel-token-alist)
243 (add-hook 'skeleton-end-hook 'gpr-indent-statement nil t)
244 (when (and gpr-skel-initial-string
246 (insert gpr-skel-initial-string))
249 (provide 'gpr-skeletons)
252 (setq gpr-expand 'skeleton-expand)
254 (add-hook 'gpr-mode-hook 'gpr-skel-setup)