/misc/fuel/fuel-scaffold.el

http://github.com/abeaumont/factor · Emacs Lisp · 245 lines · 193 code · 38 blank · 14 comment · 27 complexity · 26839d4e4bd70dba885716426a58f380 MD5 · raw file

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