factor/misc/fuel/fuel-refactor.el

307 lines
10 KiB
EmacsLisp
Raw Normal View History

2009-01-07 19:30:12 -05:00
;;; fuel-refactor.el -- code refactoring support
;; 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: Thu Jan 08, 2009 00:57
;;; Comentary:
;; Utilities performing refactoring on factor code.
;;; Code:
(require 'fuel-base)
(require 'fuel-scaffold)
2009-01-07 19:30:12 -05:00
(require 'fuel-stack)
(require 'fuel-xref)
(require 'fuel-debug-uses)
(require 'factor-mode)
2009-01-07 19:30:12 -05:00
2009-01-22 17:25:17 -05:00
(require 'etags)
;;; Word definitions in buffer
(defconst fuel-refactor--next-defun-regex
(format "^\\(:\\|MEMO:\\|MACRO:\\):? +\\(\\w+\\)\\(%s\\)\\([^;]+?\\) ;\\_>"
factor-stack-effect-regex))
(defun fuel-refactor--previous-defun ()
(let ((pos) (result))
(while (and (not result)
(setq pos (factor-beginning-of-defun)))
(setq result (looking-at fuel-refactor--next-defun-regex)))
(when (and result pos)
(let ((name (match-string-no-properties 2))
(body (match-string-no-properties 4))
(end (match-end 0)))
(list (split-string (or body "") nil t) name pos end)))))
(defun fuel-refactor--find (code to)
(let ((candidate) (result))
(while (and (not result)
(setq candidate (fuel-refactor--previous-defun))
(> (point) to))
(when (equal (car candidate) code)
(setq result (cdr candidate))))
result))
(defun fuel-refactor--reuse-p (word)
(save-excursion
(mark-defun)
(move-overlay fuel-stack--overlay (1+ (point)) (mark))
(unwind-protect
(and (y-or-n-p (format "Use existing word '%s'? " word)) word)
(delete-overlay fuel-stack--overlay))))
(defun fuel-refactor--code-rx (code)
(let ((words (split-string code nil t)))
(mapconcat 'regexp-quote words "[ \n\f\r]+")))
2009-01-07 19:30:12 -05:00
;;; Extract word:
(defun fuel-refactor--reuse-existing (code)
(save-excursion
(mark-defun)
(let ((code (split-string (substring-no-properties code) nil t))
(down (mark))
(found)
(result))
(while (and (not result)
(setq found (fuel-refactor--find code (point-min))))
(when found (setq result (fuel-refactor--reuse-p (car found)))))
(goto-char (point-max))
(while (and (not result)
(setq found (fuel-refactor--find code down)))
(when found (setq result (fuel-refactor--reuse-p (car found)))))
(and result found))))
(defsubst fuel-refactor--insertion-point ()
(max (save-excursion (factor-beginning-of-defun) (point))
(save-excursion
(re-search-backward factor-end-of-def-regex nil t)
(forward-line 1)
(skip-syntax-forward "-"))))
(defun fuel-refactor--insert-word (word stack-effect code)
(let ((start (goto-char (fuel-refactor--insertion-point))))
(open-line 1)
(insert ": " word " " stack-effect "\n" (or code " ") " ;\n")
(indent-region start (point))
(move-overlay fuel-stack--overlay start (point))))
(defun fuel-refactor--extract-other (start end word code)
(unwind-protect
(when (y-or-n-p "Apply refactoring to rest of buffer? ")
(save-excursion
(let ((rx (fuel-refactor--code-rx code))
(end (point)))
(query-replace-regexp rx word t (point-min) start)
(query-replace-regexp rx word t end (point-max)))))
(delete-overlay fuel-stack--overlay)))
2009-01-08 11:00:48 -05:00
(defun fuel-refactor--extract (begin end)
(let* ((rp (< begin end))
(code (and rp (buffer-substring begin end)))
(existing (and code (fuel-refactor--reuse-existing code)))
(code-str (and code (or existing (fuel-region-to-string begin end))))
(word (or (car existing) (read-string "New word name: ")))
(stack-effect (or existing
(and code-str (fuel-stack--infer-effect code-str))
(read-string "Stack effect: "))))
(when rp
(goto-char begin)
(delete-region begin end)
(insert word)
(indent-region begin (point)))
(save-excursion
(let ((start (or (cadr existing) (point))))
(unless existing
(fuel-refactor--insert-word word stack-effect code))
(if rp
(fuel-refactor--extract-other start
(or (car (cddr existing)) (point))
word code)
(unwind-protect
(sit-for fuel-stack-highlight-period)
(delete-overlay fuel-stack--overlay)))))))
2009-01-07 19:30:12 -05:00
2009-01-08 11:00:48 -05:00
(defun fuel-refactor-extract-region (begin end)
"Extracts current region as a separate word."
(interactive "r")
(if (= begin end)
(fuel-refactor--extract begin end)
(let ((begin (save-excursion
(goto-char begin)
(when (zerop (skip-syntax-backward "w"))
(skip-syntax-forward "-"))
(point)))
(end (save-excursion
(goto-char end)
(skip-syntax-forward "w")
(point))))
(fuel-refactor--extract begin end))))
2009-01-08 11:00:48 -05:00
(defun fuel-refactor-extract-sexp ()
"Extracts current innermost sexp (up to point) as a separate
word."
(interactive)
(fuel-refactor-extract-region (1+ (factor-beginning-of-sexp-pos))
(if (looking-at-p ";")
(point)
(save-excursion
(factor-end-of-symbol) (point)))))
2009-01-08 11:00:48 -05:00
;;; Convert word to generic + method:
(defun fuel-refactor-make-generic ()
"Inserts a new generic definition with the current word's stack effect.
The word's body is put in a new method for the generic."
(interactive)
(let ((p (point)))
(factor-beginning-of-defun)
(unless (re-search-forward factor-word-signature-regex nil t)
(goto-char p)
(error "Cannot find a proper word definition here"))
(let ((begin (match-beginning 0))
(end (match-end 0))
(name (match-string-no-properties 1))
(cls (read-string "Method's class (object): " nil nil "object")))
(goto-char begin)
(insert "GENERIC")
(goto-char (+ end 7))
(newline 2)
(insert "M: " cls " " name " "))))
2009-01-12 22:06:21 -05:00
;;; Inline word:
(defun fuel-refactor--word-def (word)
(let ((def (fuel-eval--retort-result
(fuel-eval--send/wait `(:fuel* (,word fuel-word-def) "fuel")))))
(when def
(substring (substring def 2) 0 -2))))
(defun fuel-refactor-inline-word ()
"Inserts definition of word at point."
(interactive)
(let ((word (factor-symbol-at-point)))
2009-01-12 22:06:21 -05:00
(unless word (error "No word at point"))
(let ((code (fuel-refactor--word-def word)))
(unless code (error "Word's definition not found"))
(factor-beginning-of-symbol)
2009-01-12 22:06:21 -05:00
(kill-word 1)
(let ((start (point)))
(insert code)
(save-excursion (font-lock-fontify-region start (point)))
(indent-region start (point))))))
;;; Rename word:
2009-01-22 17:25:17 -05:00
(defsubst fuel-refactor--rename-word (from to file)
(let ((files (fuel-xref--word-callers-files from)))
(tags-query-replace from to t `(cons ,file ',files))
files))
2009-01-22 17:25:17 -05:00
(defun fuel-refactor--def-word ()
(save-excursion
(factor-beginning-of-defun)
(or (and (looking-at factor-method-definition-regex)
(match-string-no-properties 3))
(and (looking-at factor-word-definition-regex)
2009-01-22 17:25:17 -05:00
(match-string-no-properties 2)))))
(defun fuel-refactor-rename-word (&optional arg)
"Rename globally the word whose definition point is at.
With prefix argument, use word at point instead."
(interactive "P")
(let* ((from (if arg (factor-symbol-at-point) (fuel-refactor--def-word)))
2009-01-22 17:25:17 -05:00
(from (read-string "Rename word: " from))
(to (read-string (format "Rename '%s' to: " from)))
(buffer (current-buffer)))
(fuel-refactor--rename-word from to (buffer-file-name))))
;;; Extract vocab:
(defun fuel-refactor--insert-using (vocab)
(save-excursion
(goto-char (point-min))
(let ((usings (sort (cons vocab (factor-usings)) 'string<)))
(fuel-debug--replace-usings (buffer-file-name) usings))))
(defun fuel-refactor--vocab-root (vocab)
(let ((cmd `(:fuel* (,vocab fuel-scaffold-get-root) "fuel")))
(fuel-eval--retort-result (fuel-eval--send/wait cmd))))
2009-01-08 11:00:48 -05:00
(defun fuel-update-usings (&optional arg)
"Asks factor for the vocabularies needed by this file,
optionally updating the its USING: line.
With prefix argument, ask for the file name."
(interactive "P")
(let ((file (car (fuel-mode--read-file arg))))
(when file (fuel-debug--uses-for-file file))))
(defun fuel-refactor--extract-vocab (begin end)
(when (< begin end)
(let* ((str (buffer-substring begin end))
(buffer (current-buffer))
(vocab (factor-current-vocab))
(vocab-hint (and vocab (format "%s." vocab)))
(root-hint (fuel-refactor--vocab-root vocab))
(vocab (fuel-scaffold-vocab t vocab-hint root-hint)))
(with-current-buffer buffer
(delete-region begin end)
(fuel-refactor--insert-using vocab))
(newline)
(insert str)
(newline)
(save-buffer)
(fuel-update-usings))))
(defun fuel-refactor-extract-vocab (begin end)
"Creates a new vocab with the words in current region.
The region is extended to the closest definition boundaries."
(interactive "r")
(fuel-refactor--extract-vocab (save-excursion (goto-char begin)
(mark-defun)
(point))
(save-excursion (goto-char end)
(mark-defun)
(mark))))
2009-01-07 19:30:12 -05:00
;;; Extract article:
(defun fuel-refactor-extract-article (begin end)
"Extracts region as a new ARTICLE form."
(interactive "r")
(let ((topic (read-string "Article topic: "))
(title (read-string "Article title: ")))
(kill-region begin end)
(insert (format "{ $subsection %s }\n" topic))
(end-of-line 0)
(save-excursion
(goto-char (fuel-refactor--insertion-point))
(open-line 1)
(let ((start (point)))
(insert (format "ARTICLE: %S %S\n" topic title))
(yank)
(when (looking-at "^ *$") (end-of-line 0))
(insert " ;")
(unwind-protect
(progn
(move-overlay fuel-stack--overlay start (point))
(sit-for fuel-stack-highlight-period))
(delete-overlay fuel-stack--overlay))))))
2009-01-07 19:30:12 -05:00
(provide 'fuel-refactor)
2009-01-07 19:30:12 -05:00
;;; fuel-refactor.el ends here