factor/misc/fuel/fuel-refactor.el

307 lines
10 KiB
EmacsLisp
Raw Blame History

This file contains invisible Unicode characters!

This file contains invisible Unicode characters that may be processed differently from what appears below. If your use case is intentional and legitimate, you can safely ignore this warning. Use the Escape button to reveal hidden characters.

;;; 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)
(require 'fuel-stack)
(require 'fuel-xref)
(require 'fuel-debug-uses)
(require 'factor-mode)
(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]+")))
;;; 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)))
(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)))))))
(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))))
(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)))))
;;; 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 " "))))
;;; 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)))
(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)
(kill-word 1)
(let ((start (point)))
(insert code)
(save-excursion (font-lock-fontify-region start (point)))
(indent-region start (point))))))
;;; Rename word:
(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))
(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)
(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)))
(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))))
(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))))
;;; 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))))))
(provide 'fuel-refactor)
;;; fuel-refactor.el ends here