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