/misc/fuel/fuel-scaffold.el
Emacs Lisp | 279 lines | 218 code | 43 blank | 18 comment | 27 complexity | 0c8a04d229c512d0302d7db5e3ae304e MD5 | raw file
- ;;; 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 (let ((cmd '(:fuel* (developer-name get :get) "fuel")))
- (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
- fuel-scaffold-developer-name
- user-full-name
- "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--dev-name) fuel-scaffold-help)
- "fuel")))
- (fuel-eval--send/wait cmd)))
- (defsubst fuel-scaffold--create-tests (vocab)
- (let ((cmd `(:fuel* (,vocab ,(fuel-scaffold--dev-name) fuel-scaffold-tests)
- "fuel")))
- (fuel-eval--send/wait cmd)))
- (defsubst fuel-scaffold--create-authors (vocab)
- (let ((cmd `(:fuel* (,vocab ,(fuel-scaffold--dev-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' 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--dev-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' 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' 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' 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