misc/fuel/fuel-refactor.el

   1 ;;; fuel-refactor.el -- code refactoring support -*- lexical-binding: t -*-
   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: Thu Jan 08, 2009 00:57
   9
  10 ;;; Comentary:
  11
  12 ;; Utilities performing refactoring on factor code.
  13
  14 ;;; Code:
  15
  16 (require 'fuel-base)
  17 (require 'fuel-scaffold)
  18 (require 'fuel-stack)
  19 (require 'fuel-xref)
  20 (require 'fuel-debug-uses)
  21 (require 'factor-mode)
  22
  23 (require 'etags)
  24
  25 \f
  26 ;;; Word definitions in buffer
  27
  28 (defconst fuel-refactor--next-defun-regex
  29   (format "^\\(:\\|MEMO:\\|MACRO:\\):? +\\(\\w+\\)\\(%s\\)\\([^;]+?\\) ;\\_>"
  30           factor-stack-effect-regex))
  31
  32 (defun fuel-refactor--previous-defun ()
  33   (let ((pos) (result))
  34     (while (and (not result)
  35                 (setq pos (factor-beginning-of-defun)))
  36       (setq result (looking-at fuel-refactor--next-defun-regex)))
  37     (when (and result pos)
  38       (let ((name (match-string-no-properties 2))
  39             (body (match-string-no-properties 4))
  40             (end (match-end 0)))
  41         (list (split-string (or body "") nil t) name pos end)))))
  42
  43 (defun fuel-refactor--find (code to)
  44   (let ((candidate) (result))
  45     (while (and (not result)
  46                 (setq candidate (fuel-refactor--previous-defun))
  47                 (> (point) to))
  48       (when (equal (car candidate) code)
  49         (setq result (cdr candidate))))
  50     result))
  51
  52 (defun fuel-refactor--reuse-p (word)
  53   (save-excursion
  54     (mark-defun)
  55     (move-overlay fuel-stack--overlay (1+ (point)) (mark))
  56     (unwind-protect
  57         (and (y-or-n-p (format "Use existing word '%s'? " word)) word)
  58       (delete-overlay fuel-stack--overlay))))
  59
  60 (defun fuel-refactor--code-rx (code)
  61   (let ((words (split-string code nil t)))
  62     (mapconcat 'regexp-quote words "[ \n\f\r]+")))
  63
  64 \f
  65 ;;; Extract word:
  66
  67 (defun fuel-refactor--reuse-existing (code)
  68   (save-excursion
  69     (mark-defun)
  70     (let ((code (split-string (substring-no-properties code) nil t))
  71           (down (mark))
  72           (found)
  73           (result))
  74       (while (and (not result)
  75                   (setq found (fuel-refactor--find code (point-min))))
  76         (when found (setq result (fuel-refactor--reuse-p (car found)))))
  77       (goto-char (point-max))
  78       (while (and (not result)
  79                   (setq found (fuel-refactor--find code down)))
  80         (when found (setq result (fuel-refactor--reuse-p (car found)))))
  81       (and result found))))
  82
  83 (defsubst fuel-refactor--insertion-point ()
  84   (max (save-excursion (factor-beginning-of-defun) (point))
  85        (save-excursion
  86          (re-search-backward factor-end-of-def-regex nil t)
  87          (forward-line 1)
  88          (skip-syntax-forward "-"))))
  89
  90 (defun fuel-refactor--insert-word (word stack-effect code)
  91   (let ((start (goto-char (fuel-refactor--insertion-point))))
  92     (open-line 1)
  93     (insert ": " word " " stack-effect "\n" (or code " ") " ;\n")
  94     (indent-region start (point))
  95     (move-overlay fuel-stack--overlay start (point))))
  96
  97 (defun fuel-refactor--extract-other (start end word code)
  98   (unwind-protect
  99       (when (y-or-n-p "Apply refactoring to rest of buffer? ")
 100         (save-excursion
 101           (let ((rx (fuel-refactor--code-rx code))
 102                 (end (point)))
 103             (query-replace-regexp rx word t (point-min) start)
 104             (query-replace-regexp rx word t end (point-max)))))
 105     (delete-overlay fuel-stack--overlay)))
 106
 107 (defun fuel-refactor--extract (begin end)
 108   (let* ((rp (< begin end))
 109          (code (and rp (buffer-substring begin end)))
 110          (existing (and code (fuel-refactor--reuse-existing code)))
 111          (code-str (and code (or existing (fuel-region-to-string begin end))))
 112          (word (or (car existing) (read-string "New word name: ")))
 113          (stack-effect (or existing
 114                            (and code-str (fuel-stack--infer-effect code-str))
 115                            (read-string "Stack effect: "))))
 116     (when rp
 117       (goto-char begin)
 118       (delete-region begin end)
 119       (insert word)
 120       (indent-region begin (point)))
 121     (save-excursion
 122       (let ((start (or (cadr existing) (point))))
 123         (unless existing
 124           (fuel-refactor--insert-word word stack-effect code))
 125         (if rp
 126             (fuel-refactor--extract-other start
 127                                           (or (car (cddr existing)) (point))
 128                                           word code)
 129           (unwind-protect
 130               (sit-for fuel-stack-highlight-period)
 131             (delete-overlay fuel-stack--overlay)))))))
 132
 133 (defun fuel-refactor-extract-region (begin end)
 134   "Extracts current region as a separate word."
 135   (interactive "r")
 136   (if (= begin end)
 137       (fuel-refactor--extract begin end)
 138     (let ((begin (save-excursion
 139                    (goto-char begin)
 140                    (when (zerop (skip-syntax-backward "w"))
 141                      (skip-syntax-forward "-"))
 142                    (point)))
 143           (end (save-excursion
 144                  (goto-char end)
 145                  (skip-syntax-forward "w")
 146                  (point))))
 147       (fuel-refactor--extract begin end))))
 148
 149 (defun fuel-refactor-extract-sexp ()
 150   "Extracts current innermost sexp (up to point) as a separate
 151 word."
 152   (interactive)
 153   (fuel-refactor-extract-region (1+ (factor-beginning-of-sexp-pos))
 154                                 (if (looking-at-p ";")
 155                                     (point)
 156                                   (save-excursion
 157                                     (factor-end-of-symbol) (point)))))
 158
 159 \f
 160 ;;; Convert word to generic + method:
 161
 162 (defun fuel-refactor-make-generic ()
 163   "Inserts a new generic definition with the current word's stack effect.
 164 The word's body is put in a new method for the generic."
 165   (interactive)
 166   (let ((p (point)))
 167     (factor-beginning-of-defun)
 168     (unless (re-search-forward factor-word-signature-regex nil t)
 169       (goto-char p)
 170       (error "Cannot find a proper word definition here"))
 171     (let ((begin (match-beginning 0))
 172           (end (match-end 0))
 173           (name (match-string-no-properties 1))
 174           (cls (read-string "Method's class (object): " nil nil "object")))
 175       (goto-char begin)
 176       (insert "GENERIC")
 177       (goto-char (+ end 7))
 178       (newline 2)
 179       (insert "M: " cls " " name " "))))
 180
 181 \f
 182 ;;; Inline word:
 183
 184 (defun fuel-refactor--word-def (word)
 185   (let ((def (fuel-eval--retort-result
 186               (fuel-eval--send/wait `(:fuel* (,word fuel-word-def) "fuel")))))
 187     (when def
 188       (substring (substring def 2) 0 -2))))
 189
 190 (defun fuel-refactor-inline-word ()
 191   "Inserts definition of word at point."
 192   (interactive)
 193   (let ((word (factor-symbol-at-point)))
 194     (unless word (error "No word at point"))
 195     (let ((code (fuel-refactor--word-def word)))
 196       (unless code (error "Word's definition not found"))
 197       (factor-beginning-of-symbol)
 198       (kill-sexp 1)
 199       (let ((start (point)))
 200         (insert code)
 201         (save-excursion (font-lock-fontify-region start (point)))
 202         (indent-region start (point))))))
 203
 204 \f
 205 ;;; Rename word:
 206
 207 (defsubst fuel-refactor--rename-word (from to file)
 208   (let ((files (fuel-xref--word-callers-files from)))
 209     (tags-query-replace from to t `(cons ,file ',files))
 210     files))
 211
 212 (defun fuel-refactor--def-word ()
 213   (save-excursion
 214     (factor-beginning-of-defun)
 215     (or (and (looking-at factor-method-definition-regex)
 216              (match-string-no-properties 3))
 217         (and (looking-at factor-word-definition-regex)
 218              (match-string-no-properties 2)))))
 219
 220 (defun fuel-refactor-rename-word (&optional arg)
 221   "Rename globally the word whose definition point is at.
 222 With prefix argument, use word at point instead."
 223   (interactive "P")
 224   (let* ((from (if arg (factor-symbol-at-point) (fuel-refactor--def-word)))
 225          (from (read-string "Rename word: " from))
 226          (to (read-string (format "Rename '%s' to: " from))))
 227     (fuel-refactor--rename-word from to (buffer-file-name))))
 228
 229 \f
 230 ;;; Extract vocab:
 231
 232 (defun fuel-refactor--insert-using (vocab)
 233   (save-excursion
 234     (goto-char (point-min))
 235     (let ((usings (sort (cons vocab (factor-usings)) 'string<)))
 236       (fuel-debug--replace-usings (buffer-file-name) usings))))
 237
 238 (defun fuel-refactor--vocab-root (vocab)
 239   (let ((cmd `(:fuel* (,vocab fuel-scaffold-get-root) "fuel")))
 240     (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
 241
 242 (defun fuel-update-usings (&optional arg)
 243   "Asks factor for the vocabularies needed by this file,
 244 optionally updating the its USING: line.
 245 With prefix argument, ask for the file name."
 246   (interactive "P")
 247   (let ((file (car (fuel-mode--read-file arg))))
 248     (when file (fuel-debug--uses-for-file file))))
 249
 250 (defun fuel-refactor--extract-vocab (begin end)
 251   (when (< begin end)
 252     (let* ((str (buffer-substring begin end))
 253            (buffer (current-buffer))
 254            (vocab (factor-current-vocab))
 255            (vocab-hint (and vocab (format "%s." vocab)))
 256            (root-hint (fuel-refactor--vocab-root vocab))
 257            (vocab (fuel-scaffold-vocab t vocab-hint root-hint)))
 258       (with-current-buffer buffer
 259         (delete-region begin end)
 260         (fuel-refactor--insert-using vocab))
 261       (newline)
 262       (insert str)
 263       (newline)
 264       (save-buffer)
 265       (fuel-update-usings))))
 266
 267 (defun fuel-refactor-extract-vocab (begin end)
 268   "Creates a new vocab with the words in current region.
 269 The region is extended to the closest definition boundaries."
 270   (interactive "r")
 271   (fuel-refactor--extract-vocab (save-excursion (goto-char begin)
 272                                                 (mark-defun)
 273                                                 (point))
 274                                 (save-excursion (goto-char end)
 275                                                 (mark-defun)
 276                                                 (mark))))
 277 \f
 278 ;;; Extract article:
 279
 280 (defun fuel-refactor-extract-article (begin end)
 281   "Extracts region as a new ARTICLE form."
 282   (interactive "r")
 283   (let ((topic (read-string "Article topic: "))
 284         (title (read-string "Article title: ")))
 285     (kill-region begin end)
 286     (insert (format "{ $subsection %s }\n" topic))
 287     (end-of-line 0)
 288     (save-excursion
 289       (goto-char (fuel-refactor--insertion-point))
 290       (open-line 1)
 291       (let ((start (point)))
 292         (insert (format "ARTICLE: %S %S\n" topic title))
 293         (yank)
 294         (when (looking-at "^ *$") (end-of-line 0))
 295         (insert " ;")
 296         (unwind-protect
 297             (progn
 298               (move-overlay fuel-stack--overlay start (point))
 299               (sit-for fuel-stack-highlight-period))
 300           (delete-overlay fuel-stack--overlay))))))
 301
 302 \f
 303 (provide 'fuel-refactor)
 304
 305 ;;; fuel-refactor.el ends here