1 ;;; fuel-scaffold.el -- interaction with tools.scaffold -*- lexical-binding: t -*-
3 ;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
4 ;; See https://factorcode.org/license.txt for BSD license.
6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
7 ;; Keywords: languages, fuel, factor
8 ;; Start date: Sun Jan 11, 2009 18:40
12 ;; Utilities for creating new vocabulary files and other boilerplate.
13 ;; Mainly, an interface to Factor's tools.scaffold.
20 (require 'factor-mode)
26 (defgroup fuel-scaffold nil
27 "Options for FUEL's scaffolding."
30 ;;; Auxiliary functions:
32 (defun fuel-mode--code-file (kind &optional file)
33 (let* ((file (or file (buffer-file-name)))
34 (bn (file-name-nondirectory file)))
35 (and (string-match (format "\\(.+\\)-%s\\.factor$" kind) bn)
36 (expand-file-name (concat (match-string 1 bn) ".factor")
37 (file-name-directory file)))))
39 (defun fuel-mode--in-docs (&optional file)
40 (fuel-mode--code-file "docs" file))
42 (defun fuel-mode--in-tests (&optional file)
43 (fuel-mode--code-file "tests" file))
45 (defun fuel-scaffold--vocab-roots ()
46 (let ((cmd '(:fuel* (vocab-roots get)
47 "fuel" ("namespaces" "vocabs.loader"))))
48 (nth 1 (fuel-eval--send/wait cmd))))
50 (defun fuel-scaffold--dev-name ()
51 (or (let ((cmd '(:fuel* (developer-name get)
53 ("namespaces" "tools.scaffold"))))
54 (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
58 (defun fuel-scaffold--first-vocab ()
59 (goto-char (point-min))
60 (re-search-forward factor-current-vocab-regex nil t))
62 (defsubst fuel-scaffold--vocab (file)
63 (with-current-buffer (find-file-noselect file)
64 (fuel-scaffold--first-vocab)
65 (factor-current-vocab)))
67 (defconst fuel-scaffold--tests-header-format
68 "! Copyright (C) %s %s
69 ! See https://factorcode.org/license.txt for BSD license.
70 USING: %s tools.test ;
74 (defvar fuel-scaffold-test-autoinsert-p nil)
75 (defvar fuel-scaffold-help-autoinsert-p nil)
76 (defvar fuel-scaffold-help-header-only-p nil)
78 (defsubst fuel-scaffold--check-auto (var)
79 (and var (or (eq var 'always) (y-or-n-p "Insert template? "))))
81 (defun fuel-scaffold--tests (parent)
82 (when (and parent (fuel-scaffold--check-auto fuel-scaffold-test-autoinsert-p))
83 (let ((year (format-time-string "%Y"))
84 (name (fuel-scaffold--dev-name))
85 (vocab (fuel-scaffold--vocab parent)))
86 (insert (format fuel-scaffold--tests-header-format
87 year name vocab vocab))
90 (defsubst fuel-scaffold--create-docs (vocab)
91 (let ((cmd `(:fuel* (,vocab ,(fuel-scaffold--dev-name) fuel-scaffold-help)
93 (fuel-eval--send/wait cmd)))
95 (defsubst fuel-scaffold--create-tests (vocab)
96 (let ((cmd `(:fuel* (,vocab ,(fuel-scaffold--dev-name) fuel-scaffold-tests)
98 (fuel-eval--send/wait cmd)))
100 (defsubst fuel-scaffold--create-authors (vocab)
101 (let ((cmd `(:fuel* (,vocab ,(fuel-scaffold--dev-name)
102 fuel-scaffold-authors) "fuel")))
103 (fuel-eval--send/wait cmd)))
105 (defsubst fuel-scaffold--create-tags (vocab tags)
106 (let ((cmd `(:fuel* (,vocab ,tags fuel-scaffold-tags) "fuel")))
107 (fuel-eval--send/wait cmd)))
109 (defsubst fuel-scaffold--create-summary (vocab summary)
110 (let ((cmd `(:fuel* (,vocab ,summary fuel-scaffold-summary) "fuel")))
111 (fuel-eval--send/wait cmd)))
113 (defsubst fuel-scaffold--create-platforms (vocab platforms)
114 (let ((cmd `(:fuel* (,vocab ,platforms fuel-scaffold-platforms) "fuel")))
115 (fuel-eval--send/wait cmd)))
117 (defun fuel-scaffold--help (parent)
118 (when (and parent (fuel-scaffold--check-auto fuel-scaffold-help-autoinsert-p))
119 (let* ((ret (fuel-scaffold--create-docs (fuel-scaffold--vocab parent)))
120 (file (fuel-eval--retort-result ret)))
122 (revert-buffer t t t)
123 (when (and fuel-scaffold-help-header-only-p
124 (fuel-scaffold--first-vocab))
125 (delete-region (1+ (point)) (point-max))
127 (message "Inserting template ... done."))
128 (goto-char (point-min)))))
130 (defun fuel-scaffold--maybe-insert ()
132 (or (fuel-scaffold--tests (fuel-mode--in-tests))
133 (fuel-scaffold--help (fuel-mode--in-docs)))))
139 (defun fuel-scaffold-vocab (&optional other-window name-hint root-hint)
140 "Creates a directory in the given root for a new vocabulary and
141 adds source and authors.txt files. Prompts the user for optional summary,
142 tags, help, and test file creation.
144 You can configure `user-full-name' for the name to be inserted in
145 the generated files."
147 (let* ((name (read-string "Vocab name: " name-hint))
148 (root (completing-read "Vocab root: "
149 (fuel-scaffold--vocab-roots)
150 nil t (or root-hint "resource:")))
151 (summary (read-string "Vocab summary (empty for none): "))
152 (tags (read-string "Vocab tags (empty for none): "))
153 (platforms (read-string "Vocab platforms (empty for all): "))
154 (help (y-or-n-p "Scaffold help? "))
155 (tests (y-or-n-p "Scaffold tests? "))
156 (cmd `(:fuel* (,root ,name ,(fuel-scaffold--dev-name)
157 fuel-scaffold-vocab) "fuel"))
158 (ret (fuel-eval--send/wait cmd))
159 (file (fuel-eval--retort-result ret)))
161 (error "Error creating vocab (%s)" (car (fuel-eval--retort-error ret))))
162 (when (not (equal "" summary))
163 (fuel-scaffold--create-summary name summary))
164 (when (not (equal "" tags))
165 (fuel-scaffold--create-tags name tags))
166 (when (not (equal "" platforms))
167 (fuel-scaffold--create-platforms name platforms))
169 (fuel-scaffold--create-docs name))
171 (fuel-scaffold--create-tests name))
172 (if other-window (find-file-other-window file) (find-file file))
173 (goto-char (point-max))
177 (defun fuel-scaffold-help (&optional arg)
178 "Creates, if it does not already exist, a help file with
179 scaffolded help for each word in the current vocabulary.
181 With prefix argument, ask for the vocabulary name. You can
182 configure `user-full-name' for the name to be
183 inserted in the generated file."
185 (let* ((vocab (or (and (not arg) (factor-current-vocab))
186 (fuel-completion--read-vocab nil)))
187 (ret (fuel-scaffold--create-docs vocab))
188 (file (fuel-eval--retort-result ret)))
190 (error "Error creating help file: %s"
191 (car (fuel-eval--retort-error ret))))
195 (defun fuel-scaffold-tests (&optional arg)
196 "Creates, if it does not already exist, a tests file for the current
199 With prefix argument, ask for the vocabulary name. You can
200 configure `user-full-name' for the name to be inserted in the
203 (let* ((vocab (or (and (not arg) (factor-current-vocab))
204 (fuel-completion--read-vocab nil)))
205 (ret (fuel-scaffold--create-tests vocab))
206 (file (fuel-eval--retort-result ret)))
208 (error "Error creating tests file: %s"
209 (car (fuel-eval--retort-error ret))))
212 (defun fuel-scaffold-authors (&optional arg)
213 "Creates, if it does not already exist, an authors file for the current
216 With prefix argument, ask for the vocabulary name. You can
217 configure `user-full-name' for the name to be
218 inserted in the generated file."
220 (let* ((vocab (or (and (not arg) (factor-current-vocab))
221 (fuel-completion--read-vocab nil)))
222 (ret (fuel-scaffold--create-authors vocab))
223 (file (fuel-eval--retort-result ret)))
225 (error "Error creating authors file: %s"
226 (car (fuel-eval--retort-error ret))))
229 (defun fuel-scaffold-tags (&optional arg)
230 "Creates, if it does not already exist, a tags file for the current
233 (let* ((vocab (or (and (not arg) (factor-current-vocab))
234 (fuel-completion--read-vocab nil)))
235 (tags (read-string "Tags: "))
236 (ret (fuel-scaffold--create-tags vocab tags))
237 (file (fuel-eval--retort-result ret)))
239 (error "Error creating tags file: %s"
240 (car (fuel-eval--retort-error ret))))
243 (defun fuel-scaffold-summary (&optional arg)
244 "Creates, if it does not already exist, a summary file for the current
247 (let* ((vocab (or (and (not arg ) (factor-current-vocab))
248 (fuel-completion--read-vocab nil)))
249 (summary (read-string "Summary: "))
250 (ret (fuel-scaffold--create-summary vocab summary))
251 (file (fuel-eval--retort-result ret)))
253 (error "Error creating summary file: %s"
254 (car (fuel-eval--retort-error ret))))
257 (defun fuel-scaffold-platforms (&optional arg)
258 "Creates, if it does not already exist, a platforms file for the current
261 (let* ((vocab (or (and (not arg ) (factor-current-vocab))
262 (fuel-completion--read-vocab nil)))
263 (platforms (read-string "Platforms: "))
264 (ret (fuel-scaffold--create-platforms vocab platforms))
265 (file (fuel-eval--retort-result ret)))
267 (error "Error creating platforms file: %s"
268 (car (fuel-eval--retort-error ret))))
272 (provide 'fuel-scaffold)
274 ;;; fuel-scaffold.el ends here