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