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