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 \f
  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 \f
  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.
  61 USING: %s tools.test ;
  62 IN: %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 \f
 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
 126 adds source and authors.txt files. Prompts the user for optional summary,
 127 tags, help, and test file creation.
 128
 129 You 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
 163 scaffolded help for each word in the current vocabulary.
 164
 165 With prefix argument, ask for the vocabulary name.
 166 You 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
 180 With prefix argument, ask for the vocabulary name.
 181 You 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
 195 With prefix argument, ask for the vocabulary name.
 196 You 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 \f
 244 (provide 'fuel-scaffold)
 245 ;;; fuel-scaffold.el ends here