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 (defun fuel-scaffold--help (parent)
  83   (when (and parent (fuel-scaffold--check-auto fuel-scaffold-help-autoinsert-p))
  84     (let* ((ret (fuel-scaffold--create-docs (fuel-scaffold--vocab parent)))
  85            (file (fuel-eval--retort-result ret)))
  86       (when file
  87         (revert-buffer t t t)
  88         (when (and fuel-scaffold-help-header-only-p
  89                    (fuel-scaffold--first-vocab))
  90           (delete-region (1+ (point)) (point-max))
  91           (save-buffer))
  92         (message "Inserting template ... done."))
  93       (goto-char (point-min)))))
  94
  95 (defun fuel-scaffold--maybe-insert ()
  96   (ignore-errors
  97     (or (fuel-scaffold--tests (factor-mode--in-tests))
  98         (fuel-scaffold--help (factor-mode--in-docs)))))
  99
 100 \f
 101 ;;; User interface:
 102
 103 (defun fuel-scaffold-vocab (&optional other-window name-hint root-hint)
 104   "Creates a directory in the given root for a new vocabulary and
 105 adds source, tests and authors.txt files.
 106
 107 You can configure `fuel-scaffold-developer-name' (set by default to
 108 `user-full-name') for the name to be inserted in the generated files."
 109   (interactive)
 110   (let* ((name (read-string "Vocab name: " name-hint))
 111          (root (completing-read "Vocab root: "
 112                                 (fuel-scaffold--vocab-roots)
 113                                 nil t (or root-hint "resource:")))
 114          (cmd `(:fuel* ((,root ,name ,fuel-scaffold-developer-name)
 115                         (fuel-scaffold-vocab)) "fuel"))
 116          (ret (fuel-eval--send/wait cmd))
 117          (file (fuel-eval--retort-result ret)))
 118     (unless file
 119       (error "Error creating vocab (%s)" (car (fuel-eval--retort-error ret))))
 120     (if other-window (find-file-other-window file) (find-file file))
 121     (goto-char (point-max))
 122     name))
 123
 124 (defun fuel-scaffold-help (&optional arg)
 125   "Creates, if it does not already exist, a help file with
 126 scaffolded help for each word in the current vocabulary.
 127
 128 With prefix argument, ask for the vocabulary name.
 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 file."
 131   (interactive "P")
 132   (let* ((vocab (or (and (not arg) (fuel-syntax--current-vocab))
 133                     (fuel-completion--read-vocab nil)))
 134          (ret (fuel-scaffold--create-docs vocab))
 135          (file (fuel-eval--retort-result ret)))
 136         (unless file
 137           (error "Error creating help file" (car (fuel-eval--retort-error ret))))
 138         (find-file file)))
 139
 140 \f
 141 (provide 'fuel-scaffold)
 142 ;;; fuel-scaffold.el ends here