factor/misc/fuel/fuel-scaffold.el

;;; fuel-scaffold.el -- interaction with tools.scaffold

;; Copyright (C) 2009 Jose Antonio Ortega Ruiz
;; See http://factorcode.org/license.txt for BSD license.

;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
;; Keywords: languages, fuel, factor
;; Start date: Sun Jan 11, 2009 18:40

;;; Comentary:

;; Utilities for creating new vocabulary files and other boilerplate.
;; Mainly, an interface to Factor's tools.scaffold.

;;; Code:

(require 'fuel-eval)
(require 'fuel-edit)
(require 'fuel-base)
(require 'factor-mode)


;;; Customisation:

;;;###autoload
(defgroup fuel-scaffold nil
  "Options for FUEL's scaffolding."
  :group 'fuel)

(defcustom fuel-scaffold-developer-name nil
  "The name to be inserted as yours in scaffold templates."
  :type '(choice string
                 (const :tag "Factor's value for developer-name" nil))
  :group 'fuel-scaffold)


;;; Auxiliary functions:

(defun fuel-mode--code-file (kind &optional file)
  (let* ((file (or file (buffer-file-name)))
         (bn (file-name-nondirectory file)))
    (and (string-match (format "\\(.+\\)-%s\\.factor$" kind) bn)
         (expand-file-name (concat (match-string 1 bn) ".factor")
                           (file-name-directory file)))))

(defun fuel-mode--in-docs (&optional file)
  (fuel-mode--code-file "docs"))

(defun fuel-mode--in-tests (&optional file)
  (fuel-mode--code-file "tests"))

(defun fuel-scaffold--vocab-roots ()
  (let ((cmd '(:fuel* (vocab-roots get :get) "fuel")))
    (fuel-eval--retort-result (fuel-eval--send/wait cmd))))

(defun fuel-scaffold--dev-name ()
  (or fuel-scaffold-developer-name
      (let ((cmd '(:fuel* (developer-name get :get) "fuel")))
        (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
      "Your name"))

(defun fuel-scaffold--first-vocab ()
  (goto-char (point-min))
  (re-search-forward factor-current-vocab-regex nil t))

(defsubst fuel-scaffold--vocab (file)
  (with-current-buffer (find-file-noselect file)
    (fuel-scaffold--first-vocab)
    (factor-current-vocab)))

(defconst fuel-scaffold--tests-header-format
  "! Copyright (C) %s %s
! See http://factorcode.org/license.txt for BSD license.
USING: %s tools.test ;
IN: %s
")

(defvar fuel-scaffold-test-autoinsert-p nil)
(defvar fuel-scaffold-help-autoinsert-p nil)
(defvar fuel-scaffold-help-header-only-p nil)

(defsubst fuel-scaffold--check-auto (var)
  (and var (or (eq var 'always) (y-or-n-p "Insert template? "))))

(defun fuel-scaffold--tests (parent)
  (when (and parent (fuel-scaffold--check-auto fuel-scaffold-test-autoinsert-p))
    (let ((year (format-time-string "%Y"))
          (name (fuel-scaffold--dev-name))
          (vocab (fuel-scaffold--vocab parent)))
      (insert (format fuel-scaffold--tests-header-format
                      year name vocab vocab))
      t)))

(defsubst fuel-scaffold--create-docs (vocab)
  (let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-help)
                      "fuel")))
    (fuel-eval--send/wait cmd)))

(defsubst fuel-scaffold--create-tests (vocab)
  (let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name fuel-scaffold-tests)
                      "fuel")))
    (fuel-eval--send/wait cmd)))

(defsubst fuel-scaffold--create-authors (vocab)
  (let ((cmd `(:fuel* (,vocab ,fuel-scaffold-developer-name
                              fuel-scaffold-authors) "fuel")))
    (fuel-eval--send/wait cmd)))

(defsubst fuel-scaffold--create-tags (vocab tags)
  (let ((cmd `(:fuel* (,vocab ,tags fuel-scaffold-tags) "fuel")))
    (fuel-eval--send/wait cmd)))

(defsubst fuel-scaffold--create-summary (vocab summary)
  (let ((cmd `(:fuel* (,vocab ,summary fuel-scaffold-summary) "fuel")))
    (fuel-eval--send/wait cmd)))

(defsubst fuel-scaffold--create-platforms (vocab platforms)
  (let ((cmd `(:fuel* (,vocab ,platforms fuel-scaffold-platforms) "fuel")))
    (fuel-eval--send/wait cmd)))

(defun fuel-scaffold--help (parent)
  (when (and parent (fuel-scaffold--check-auto fuel-scaffold-help-autoinsert-p))
    (let* ((ret (fuel-scaffold--create-docs (fuel-scaffold--vocab parent)))
           (file (fuel-eval--retort-result ret)))
      (when file
        (revert-buffer t t t)
        (when (and fuel-scaffold-help-header-only-p
                   (fuel-scaffold--first-vocab))
          (delete-region (1+ (point)) (point-max))
          (save-buffer))
        (message "Inserting template ... done."))
      (goto-char (point-min)))))

(defun fuel-scaffold--maybe-insert ()
  (ignore-errors
    (or (fuel-scaffold--tests (fuel-mode--in-tests))
        (fuel-scaffold--help (fuel-mode--in-docs)))))


;;; User interface:

;;;###autoload
(defun fuel-scaffold-vocab (&optional other-window name-hint root-hint)
  "Creates a directory in the given root for a new vocabulary and
adds source and authors.txt files. Prompts the user for optional summary,
tags, help, and test file creation.

You can configure `fuel-scaffold-developer-name' (set by default to
`user-full-name') for the name to be inserted in the generated files."
  (interactive)
  (let* ((name (read-string "Vocab name: " name-hint))
         (root (completing-read "Vocab root: "
                                (fuel-scaffold--vocab-roots)
                                nil t (or root-hint "resource:")))
         (summary (read-string "Vocab summary (empty for none): "))
         (tags (read-string "Vocab tags (empty for none): "))
         (platforms (read-string "Vocab platforms (empty for all): "))
         (help (y-or-n-p "Scaffold help? "))
         (tests (y-or-n-p "Scaffold tests? "))
         (cmd `(:fuel* ((,root ,name ,fuel-scaffold-developer-name)
                        (fuel-scaffold-vocab)) "fuel"))
         (ret (fuel-eval--send/wait cmd))
         (file (fuel-eval--retort-result ret)))
    (unless file
      (error "Error creating vocab (%s)" (car (fuel-eval--retort-error ret))))
    (when (not (equal "" summary))
      (fuel-scaffold--create-summary name summary))
    (when (not (equal "" tags))
      (fuel-scaffold--create-tags name tags))
    (when (not (equal "" platforms))
      (fuel-scaffold--create-platforms name platforms))
    (when help
         (fuel-scaffold--create-docs name))
    (when tests
         (fuel-scaffold--create-tests name))
    (if other-window (find-file-other-window file) (find-file file))
    (goto-char (point-max))
    name))

;;;###autoload
(defun fuel-scaffold-help (&optional arg)
  "Creates, if it does not already exist, a help file with
scaffolded help for each word in the current vocabulary.

With prefix argument, ask for the vocabulary name.
You can configure `fuel-scaffold-developer-name' (set by default to
`user-full-name') for the name to be inserted in the generated file."
  (interactive "P")
  (let* ((vocab (or (and (not arg) (factor-current-vocab))
                    (fuel-completion--read-vocab nil)))
         (ret (fuel-scaffold--create-docs vocab))
         (file (fuel-eval--retort-result ret)))
        (unless file
          (error "Error creating help file: %s"
                 (car (fuel-eval--retort-error ret))))
        (find-file file)))

;;;###autoload
(defun fuel-scaffold-tests (&optional arg)
  "Creates, if it does not already exist, a tests file for the current
vocabulary.

With prefix argument, ask for the vocabulary name.
You can configure `fuel-scaffold-developer-name' (set by default to
`user-full-name') for the name to be inserted in the generated file."
  (interactive "P")
  (let* ((vocab (or (and (not arg) (factor-current-vocab))
                    (fuel-completion--read-vocab nil)))
         (ret (fuel-scaffold--create-tests vocab))
         (file (fuel-eval--retort-result ret)))
        (unless file
          (error "Error creating tests file: %s"
                 (car (fuel-eval--retort-error ret))))
        (find-file file)))

(defun fuel-scaffold-authors (&optional arg)
  "Creates, if it does not already exist, an authors file for the current
vocabulary.

With prefix argument, ask for the vocabulary name.
You can configure `fuel-scaffold-developer-name' (set by default to
`user-full-name') for the name to be inserted in the generated file."
  (interactive "P")
  (let* ((vocab (or (and (not arg) (factor-current-vocab))
                    (fuel-completion--read-vocab nil)))
         (ret (fuel-scaffold--create-authors vocab))
         (file (fuel-eval--retort-result ret)))
        (unless file
          (error "Error creating authors file: %s"
                 (car (fuel-eval--retort-error ret))))
        (find-file file)))

(defun fuel-scaffold-tags (&optional arg)
  "Creates, if it does not already exist, a tags file for the current
vocabulary."
  (interactive "P")
  (let* ((vocab (or (and (not arg) (factor-current-vocab))
                    (fuel-completion--read-vocab nil)))
         (tags (read-string "Tags: "))
         (ret (fuel-scaffold--create-tags vocab tags))
         (file (fuel-eval--retort-result ret)))
        (unless file
          (error "Error creating tags file: %s"
                 (car (fuel-eval--retort-error ret))))
        (find-file file)))

(defun fuel-scaffold-summary (&optional arg)
  "Creates, if it does not already exist, a summary file for the current
vocabulary."
  (interactive "P")
  (let* ((vocab (or (and (not arg ) (factor-current-vocab))
                    (fuel-completion--read-vocab nil)))
         (summary (read-string "Summary: "))
         (ret (fuel-scaffold--create-summary vocab summary))
         (file (fuel-eval--retort-result ret)))
        (unless file
          (error "Error creating summary file: %s"
                 (car (fuel-eval--retort-error ret))))
        (find-file file)))

(defun fuel-scaffold-platforms (&optional arg)
  "Creates, if it does not already exist, a platforms file for the current
vocabulary."
  (interactive "P")
  (let* ((vocab (or (and (not arg ) (factor-current-vocab))
                    (fuel-completion--read-vocab nil)))
         (platforms (read-string "Platforms: "))
         (ret (fuel-scaffold--create-platforms vocab platforms))
         (file (fuel-eval--retort-result ret)))
        (unless file
          (error "Error creating platforms file: %s"
                 (car (fuel-eval--retort-error ret))))
        (find-file file)))


(provide 'fuel-scaffold)

;;; fuel-scaffold.el ends here