/misc/fuel/fuel-scaffold.el

  1;;; fuel-scaffold.el -- interaction with tools.scaffold
  2
  3;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
  4;; See http://factorcode.org/license.txt for BSD license.
  5
  6;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
  7;; Keywords: languages, fuel, factor
  8;; Start date: Sun Jan 11, 2009 18:40
  9
 10;;; Comentary:
 11
 12;; Utilities for creating new vocabulary files and other boilerplate.
 13;; Mainly, an interface to Factor's tools.scaffold.
 14
 15;;; Code:
 16
 17(require 'fuel-eval)
 18(require 'fuel-edit)
 19(require 'fuel-syntax)
 20(require 'fuel-base)
 21
 22
 23;;; Customisation:
 24
 25(defgroup fuel-scaffold nil
 26  "Options for FUEL's scaffolding."
 27  :group 'fuel)
 28
 29(defcustom fuel-scaffold-developer-name nil
 30  "The name to be inserted as yours in scaffold templates."
 31  :type '(choice string
 32                 (const :tag "Factor's value for developer-name" nil))
 33  :group 'fuel-scaffold)
 34
 35
 36;;; Auxiliary functions:
 37
 38(defun fuel-scaffold--vocab-roots ()
 39  (let ((cmd '(:fuel* (vocab-roots get :get) "fuel")))
 40    (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 41
 42(defun fuel-scaffold--dev-name ()
 43  (or fuel-scaffold-developer-name
 44      (let ((cmd '(:fuel* (developer-name get :get) "fuel")))
 45        (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
 46      "Your name"))
 47
 48(defun fuel-scaffold--first-vocab ()
 49  (goto-char (point-min))
 50  (re-search-forward fuel-syntax--current-vocab-regex nil t))
 51
 52(defsubst fuel-scaffold--vocab (file)
 53  (save-excursion
 54    (set-buffer (find-file-noselect file))
 55    (fuel-scaffold--first-vocab)
 56    (fuel-syntax--current-vocab)))
 57
 58(defconst fuel-scaffold--tests-header-format
 59  "! Copyright (C) %s %s
 60! See http://factorcode.org/license.txt for BSD license.
 61USING: %s tools.test ;
 62IN: %s
 63")
 64
 65(defsubst fuel-scaffold--check-auto (var)
 66  (and var (or (eq var 'always) (y-or-n-p "Insert template? "))))
 67
 68(defun fuel-scaffold--tests (parent)
 69  (when (and parent (fuel-scaffold--check-auto fuel-scaffold-test-autoinsert-p))
 70    (let ((year (format-time-string "%Y"))
 71          (name (fuel-scaffold--dev-name))
 72          (vocab (fuel-scaffold--vocab parent)))
 73      (insert (format fuel-scaffold--tests-header-format
 74                      year name vocab vocab))
 75      t)))
 76
 77(defsubst fuel-scaffold--create-docs (vocab)
 78  (let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-help)
 79                      "fuel")))
 80    (fuel-eval--send/wait cmd)))
 81
 82(defsubst fuel-scaffold--create-tests (vocab)
 83  (let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-tests)
 84                      "fuel")))
 85    (fuel-eval--send/wait cmd)))
 86
 87(defsubst fuel-scaffold--create-authors (vocab)
 88  (let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-authors) "fuel")))
 89    (fuel-eval--send/wait cmd)))
 90
 91(defsubst fuel-scaffold--create-tags (vocab tags)
 92  (let ((cmd `(:fuel* (,vocab ,tags fuel-scaffold-tags) "fuel")))
 93    (fuel-eval--send/wait cmd)))
 94
 95(defsubst fuel-scaffold--create-summary (vocab summary)
 96  (let ((cmd `(:fuel* (,vocab ,summary fuel-scaffold-summary) "fuel")))
 97    (fuel-eval--send/wait cmd)))
 98
 99(defsubst fuel-scaffold--create-platforms (vocab platforms)
100  (let ((cmd `(:fuel* (,vocab ,platforms fuel-scaffold-platforms) "fuel")))
101    (fuel-eval--send/wait cmd)))
102
103(defun fuel-scaffold--help (parent)
104  (when (and parent (fuel-scaffold--check-auto fuel-scaffold-help-autoinsert-p))
105    (let* ((ret (fuel-scaffold--create-docs (fuel-scaffold--vocab parent)))
106           (file (fuel-eval--retort-result ret)))
107      (when file
108        (revert-buffer t t t)
109        (when (and fuel-scaffold-help-header-only-p
110                   (fuel-scaffold--first-vocab))
111          (delete-region (1+ (point)) (point-max))
112          (save-buffer))
113        (message "Inserting template ... done."))
114      (goto-char (point-min)))))
115
116(defun fuel-scaffold--maybe-insert ()
117  (ignore-errors
118    (or (fuel-scaffold--tests (factor-mode--in-tests))
119        (fuel-scaffold--help (factor-mode--in-docs)))))
120
121
122;;; User interface:
123
124(defun fuel-scaffold-vocab (&optional other-window name-hint root-hint)
125  "Creates a directory in the given root for a new vocabulary and
126adds source and authors.txt files. Prompts the user for optional summary,
127tags, help, and test file creation.
128
129You can configure `fuel-scaffold-developer-name' (set by default to
130`user-full-name') for the name to be inserted in the generated files."
131  (interactive)
132  (let* ((name (read-string "Vocab name: " name-hint))
133         (root (completing-read "Vocab root: "
134                                (fuel-scaffold--vocab-roots)
135                                nil t (or root-hint "resource:")))
136         (summary (read-string "Vocab summary (empty for none): "))
137         (tags (read-string "Vocab tags (empty for none): "))
138         (platforms (read-string "Vocab platforms (empty for all): "))
139         (help (y-or-n-p "Scaffold help? "))
140         (tests (y-or-n-p "Scaffold tests? "))
141         (cmd `(:fuel* ((,root ,name ,fuel-scaffold-developer-name)
142                        (fuel-scaffold-vocab)) "fuel"))
143         (ret (fuel-eval--send/wait cmd))
144         (file (fuel-eval--retort-result ret)))
145    (unless file
146      (error "Error creating vocab (%s)" (car (fuel-eval--retort-error ret))))
147    (when (not (equal "" summary))
148      (fuel-scaffold--create-summary name summary))
149    (when (not (equal "" tags))
150      (fuel-scaffold--create-tags name tags))
151    (when (not (equal "" platforms))
152      (fuel-scaffold--create-platforms name platforms))
153    (when help
154         (fuel-scaffold--create-docs name))
155    (when tests
156         (fuel-scaffold--create-tests name))
157    (if other-window (find-file-other-window file) (find-file file))
158    (goto-char (point-max))
159    name))
160
161(defun fuel-scaffold-help (&optional arg)
162  "Creates, if it does not already exist, a help file with
163scaffolded help for each word in the current vocabulary.
164
165With prefix argument, ask for the vocabulary name.
166You can configure `fuel-scaffold-developer-name' (set by default to
167`user-full-name') for the name to be inserted in the generated file."
168  (interactive "P")
169  (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
170                    (fuel-completion--read-vocab nil)))
171         (ret (fuel-scaffold--create-docs vocab))
172         (file (fuel-eval--retort-result ret)))
173        (unless file
174          (error "Error creating help file" (car (fuel-eval--retort-error ret))))
175        (find-file file)))
176
177(defun fuel-scaffold-tests (&optional arg)
178  "Creates, if it does not already exist, a tests file for the current vocabulary.
179
180With prefix argument, ask for the vocabulary name.
181You can configure `fuel-scaffold-developer-name' (set by default to
182`user-full-name') for the name to be inserted in the generated file."
183  (interactive "P")
184  (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
185                    (fuel-completion--read-vocab nil)))
186         (ret (fuel-scaffold--create-tests vocab))
187         (file (fuel-eval--retort-result ret)))
188        (unless file
189          (error "Error creating tests file" (car (fuel-eval--retort-error ret))))
190        (find-file file)))
191
192(defun fuel-scaffold-authors (&optional arg)
193  "Creates, if it does not already exist, an authors file for the current vocabulary.
194
195With prefix argument, ask for the vocabulary name.
196You can configure `fuel-scaffold-developer-name' (set by default to
197`user-full-name') for the name to be inserted in the generated file."
198  (interactive "P")
199  (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
200                    (fuel-completion--read-vocab nil)))
201         (ret (fuel-scaffold--create-authors vocab))
202         (file (fuel-eval--retort-result ret)))
203        (unless file
204          (error "Error creating authors file" (car (fuel-eval--retort-error ret))))
205        (find-file file)))
206
207(defun fuel-scaffold-tags (&optional arg)
208  "Creates, if it does not already exist, a tags file for the current vocabulary."
209  (interactive "P")
210  (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
211                    (fuel-completion--read-vocab nil)))
212         (tags (read-string "Tags: "))
213         (ret (fuel-scaffold--create-tags vocab tags))
214         (file (fuel-eval--retort-result ret)))
215        (unless file
216          (error "Error creating tags file" (car (fuel-eval--retort-error ret))))
217        (find-file file)))
218
219(defun fuel-scaffold-summary (&optional arg)
220  "Creates, if it does not already exist, a summary file for the current vocabulary."
221  (interactive "P")
222  (let* ((vocab (or (and (not arg ) (fuel-syntax--current-vocab))
223                    (fuel-completion--read-vocab nil)))
224         (summary (read-string "Summary: "))
225         (ret (fuel-scaffold--create-summary vocab summary))
226         (file (fuel-eval--retort-result ret)))
227        (unless file
228          (error "Error creating summary file" (car (fuel-eval--retort-error ret))))
229        (find-file file)))
230
231(defun fuel-scaffold-platforms (&optional arg)
232  "Creates, if it does not already exist, a platforms file for the current vocabulary."
233  (interactive "P")
234  (let* ((vocab (or (and (not arg ) (fuel-syntax--current-vocab))
235                    (fuel-completion--read-vocab nil)))
236         (platforms (read-string "Platforms: "))
237         (ret (fuel-scaffold--create-platforms vocab platforms))
238         (file (fuel-eval--retort-result ret)))
239        (unless file
240          (error "Error creating platforms file" (car (fuel-eval--retort-error ret))))
241        (find-file file)))
242
243
244(provide 'fuel-scaffold)
245;;; fuel-scaffold.el ends here