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