Merge branch 'master' into new_ui

extra/fuel/fuel.factor

@@ -148,6 +148,8 @@ MEMO: fuel-get-article-title ( name -- )
 
 : fuel-word-see ( name -- ) (fuel-word-see) fuel-eval-set-result ;
 
+: fuel-word-def ( name -- ) (fuel-word-def) fuel-eval-set-result ;
+
 : fuel-vocab-help ( name -- ) (fuel-vocab-help) fuel-eval-set-result ;
 
 : fuel-vocab-summary ( name -- )
@@ -170,4 +172,5 @@ MEMO: fuel-get-article-title ( name -- )
     dup require dup scaffold-help vocab-docs-path
     (normalize-path) fuel-eval-set-result ;
 
-: fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;
+: fuel-scaffold-get-root ( name -- ) find-vocab-root fuel-eval-set-result ;
+

extra/fuel/help/help.factor

@@ -87,13 +87,16 @@ SYMBOL: vocab-list
 
 PRIVATE>
 
-: (fuel-word-help) ( object -- object )
+: (fuel-word-help) ( name -- elem )
     fuel-find-word [ [ auto-use? on (fuel-word-element) ] with-scope ] [ f ] if* ;
 
 : (fuel-word-see) ( word -- elem )
     [ name>> \ article swap ]
     [ [ see ] with-string-writer \ $code swap 2array ] bi 3array ; inline
 
+: (fuel-word-def) ( name -- str )
+    fuel-find-word [ [ def>> pprint ] with-string-writer ] when* ; inline
+
 : (fuel-vocab-summary) ( name -- str ) >vocab-link summary ; inline
 
 : (fuel-vocab-help) ( name -- str )

misc/fuel/README

@@ -80,7 +80,8 @@ beast.
     - C-cz : switch to listener
     - C-co : cycle between code, tests and docs factor files
 
-    - M-. : edit word at point in Emacs
+    - M-. : edit word at point in Emacs (see fuel-edit-word-method custom var)
+    - M-, : go back to where M-. was last invoked
     - M-TAB : complete word at point
     - C-cC-eu : update USING: line
     - C-cC-ev : edit vocabulary (M-x fuel-edit-vocabulary)
@@ -104,6 +105,7 @@ beast.
 
     - C-cC-xs : extract innermost sexp (up to point)  as a separate word
     - C-cC-xr : extract region as a separate word
+    - C-cC-xi : replace word at point by its definition
     - C-cC-xv : extract region as a separate vocabulary
 
 *** In the listener:

misc/fuel/fuel-edit.el

@@ -17,6 +17,19 @@
 (require 'fuel-eval)
 (require 'fuel-base)
 
+(require 'etags)
+
+
+;;; Customization
+
+(defcustom fuel-edit-word-method nil
+  "How the new buffer is opened when invoking
+\\[fuel-edit-word-at-point]."
+  :group 'fuel
+  :type '(choice (const :tag "Other window" window)
+                 (const :tag "Other frame" frame)
+                 (const :tag "Current window" nil)))
+
 
 ;;; Auxiliar functions:
 
@@ -27,7 +40,9 @@
       (error "Couldn't find edit location"))
     (unless (file-readable-p (car loc))
       (error "Couldn't open '%s' for read" (car loc)))
-    (find-file-other-window (car loc))
+    (cond ((eq fuel-edit-word-method 'window) (find-file-other-window (car loc)))
+          ((eq fuel-edit-word-method 'frame) (find-file-other-frame (car loc)))
+          (t (find-file (car loc))))
     (goto-line (if (numberp (cadr loc)) (cadr loc) 1))))
 
 (defun fuel-edit--read-vocabulary-name (refresh)
@@ -46,6 +61,7 @@
 
 (defvar fuel-edit--word-history nil)
 (defvar fuel-edit--vocab-history nil)
+(defvar fuel-edit--previous-location nil)
 
 (defun fuel-edit-vocabulary (&optional refresh vocab)
   "Visits vocabulary file in Emacs.
@@ -74,10 +90,12 @@ With prefix, asks for the word to edit."
   (interactive "P")
   (let* ((word (or (and (not arg) (fuel-syntax-symbol-at-point))
                    (fuel-completion--read-word "Edit word: ")))
-         (cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
+         (cmd `(:fuel* ((:quote ,word) fuel-get-edit-location)))
+         (marker (and (not arg) (point-marker))))
     (condition-case nil
         (fuel-edit--try-edit (fuel-eval--send/wait cmd))
-      (error (fuel-edit-vocabulary nil word)))))
+      (error (fuel-edit-vocabulary nil word)))
+    (when marker (ring-insert find-tag-marker-ring marker))))
 
 (defun fuel-edit-word-doc-at-point (&optional arg word)
   "Opens a new window visiting the documentation file for the word at point.
@@ -86,7 +104,8 @@ With prefix, asks for the word to edit."
   (let* ((word (or word
                    (and (not arg) (fuel-syntax-symbol-at-point))
                    (fuel-completion--read-word "Edit word: ")))
-         (cmd `(:fuel* ((:quote ,word) fuel-get-doc-location))))
+         (cmd `(:fuel* ((:quote ,word) fuel-get-doc-location)))
+         (marker (and (not arg) (point-marker))))
     (condition-case nil
         (fuel-edit--try-edit (fuel-eval--send/wait cmd))
       (error
@@ -95,10 +114,19 @@ With prefix, asks for the word to edit."
                   (y-or-n-p (concat "No documentation found. "
                                     "Do you want to open the vocab's "
                                     "doc file? ")))
+         (when marker (ring-insert find-tag-marker-ring marker))
          (find-file-other-window
           (format "%s-docs.factor"
                   (file-name-sans-extension (buffer-file-name)))))))))
 
+(defun fuel-edit-pop-edit-word-stack ()
+  "Pop back to where \\[fuel-edit-word-at-point] or \\[fuel-edit-word-doc-at-point]
+was last invoked."
+  (interactive)
+  (condition-case nil
+      (pop-tag-mark)
+    (error "No previous location for find word or vocab invokation")))
+
 
 (provide 'fuel-edit)
 ;;; fuel-edit.el ends here

misc/fuel/fuel-font-lock.el

@@ -66,7 +66,8 @@
   (symbol variable-name "name of symbol being defined")
   (type-name type "type names")
   (vocabulary-name constant "vocabulary names")
-  (word function-name "word, generic or method being defined")))
+  (word function-name "word, generic or method being defined")
+  (invalid-syntax warning "syntactically invalid constructs")))
 
 
 ;;; Font lock:
@@ -92,8 +93,8 @@
     (,fuel-syntax--constructor-regex . 'factor-font-lock-constructor)
     (,fuel-syntax--setter-regex . 'factor-font-lock-setter-word)
     (,fuel-syntax--getter-regex . 'factor-font-lock-getter-word)
-    (,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol))
-  "Font lock keywords definition for Factor mode.")
+    (,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol)
+    (,fuel-syntax--bad-string-regex . 'factor-font-lock-invalid-syntax)))
 
 (defun fuel-font-lock--font-lock-setup (&optional keywords no-syntax)
   (set (make-local-variable 'comment-start) "! ")

misc/fuel/fuel-mode.el

@@ -181,6 +181,7 @@ interacting with a factor listener is at your disposal.
 (define-key fuel-mode-map "\C-\M-x" 'fuel-eval-definition)
 (define-key fuel-mode-map "\C-\M-r" 'fuel-eval-extended-region)
 (define-key fuel-mode-map "\M-." 'fuel-edit-word-at-point)
+(define-key fuel-mode-map "\M-," 'fuel-edit-pop-edit-word-stack)
 (define-key fuel-mode-map "\C-c\M-<" 'fuel-show-callers)
 (define-key fuel-mode-map "\C-c\M->" 'fuel-show-callees)
 (define-key fuel-mode-map (kbd "M-TAB") 'fuel-completion--complete-symbol)
@@ -197,6 +198,7 @@ interacting with a factor listener is at your disposal.
 (fuel-mode--key ?x ?s 'fuel-refactor-extract-sexp)
 (fuel-mode--key ?x ?r 'fuel-refactor-extract-region)
 (fuel-mode--key ?x ?v 'fuel-refactor-extract-vocab)
+(fuel-mode--key ?x ?i 'fuel-refactor-inline-word)
 
 (fuel-mode--key ?d ?> 'fuel-show-callees)
 (fuel-mode--key ?d ?< 'fuel-show-callers)

misc/fuel/fuel-refactor.el

@@ -18,36 +18,106 @@
 (require 'fuel-syntax)
 (require 'fuel-base)
 
+
+;;; Word definitions in buffer
+
+(defconst fuel-refactor--next-defun-regex
+  (format "^\\(:\\|MEMO:\\|MACRO:\\):? +\\(\\w+\\)\\(%s\\)\\([^;]+?\\) ;\\_>"
+          fuel-syntax--stack-effect-regex))
+
+(defun fuel-refactor--previous-defun ()
+  (let ((pos) (result))
+    (while (and (not result)
+                (setq pos (fuel-syntax--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 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))))
+
+(defun fuel-refactor--insert-word (word stack-effect code)
+  (let ((beg (save-excursion (fuel-syntax--beginning-of-defun) (point)))
+        (end (save-excursion
+               (re-search-backward fuel-syntax--end-of-def-regex nil t)
+               (forward-line 1)
+               (skip-syntax-forward "-"))))
+    (let ((start (goto-char (max beg end))))
+      (open-line 1)
+      (insert ": " word " " stack-effect "\n" code " ;\n")
+      (indent-region start (point))
+      (move-overlay fuel-stack--overlay start (point)))))
+
+(defun fuel-refactor--extract-other (start end 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* ((word (read-string "New word name: "))
-         (code (buffer-substring begin end))
-         (code-str (fuel--region-to-string begin end))
-         (stack-effect (or (fuel-stack--infer-effect code-str)
-                           (read-string "Stack effect: "))))
-    (unless (< begin end) (error "No proper region to extract"))
+  (unless (< begin end) (error "No proper region to extract"))
+  (let* ((code (buffer-substring begin end))
+         (existing (fuel-refactor--reuse-existing code))
+         (code-str (or existing (fuel--region-to-string begin end)))
+         (stack-effect (or existing
+                           (fuel-stack--infer-effect code-str)
+                           (read-string "Stack effect: ")))
+         (word (or (car existing) (read-string "New word name: "))))
     (goto-char begin)
     (delete-region begin end)
     (insert word)
     (indent-region begin (point))
-    (set-mark (point))
-    (let ((beg (save-excursion (fuel-syntax--beginning-of-defun) (point)))
-          (end (save-excursion
-                 (re-search-backward fuel-syntax--end-of-def-regex nil t)
-                 (forward-line 1)
-                 (skip-syntax-forward "-")
-                 (point))))
-      (goto-char (max beg end)))
-    (open-line 1)
-    (let ((start (point)))
-      (insert ": " word " " stack-effect "\n" code " ;\n")
-      (indent-region start (point))
-      (move-overlay fuel-stack--overlay start (point))
-      (goto-char (mark))
-      (sit-for fuel-stack-highlight-period)
-      (delete-overlay fuel-stack--overlay))))
+    (save-excursion
+      (let ((start (or (cadr existing) (point))))
+        (unless existing
+          (fuel-refactor--insert-word word stack-effect code))
+        (fuel-refactor--extract-other start
+                                      (or (car (cddr existing)) (point))
+                                      code)))))
 
 (defun fuel-refactor-extract-region (begin end)
   "Extracts current region as a separate word."
@@ -71,6 +141,29 @@ word."
                                 (if (looking-at-p ";") (point)
                                   (fuel-syntax--end-of-symbol-pos))))
 
+
+;;; 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 (fuel-syntax-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"))
+      (fuel-syntax--beginning-of-symbol)
+      (kill-word 1)
+      (let ((start (point)))
+        (insert code)
+        (save-excursion (font-lock-fontify-region start (point)))
+        (indent-region start (point))))))
+
 
 ;;; Extract vocab:
 

misc/fuel/fuel-syntax.el

@@ -93,6 +93,9 @@
 (defconst fuel-syntax--float-regex
   "\\_<-?[0-9]+\\.[0-9]*\\([eE][+-]?[0-9]+\\)?\\_>")
 
+(defconst fuel-syntax--bad-string-regex
+  "\"[^\"]*$")
+
 (defconst fuel-syntax--word-definition-regex
   (fuel-syntax--second-word-regex
    '(":" "::" "GENERIC:" "DEFER:" "HOOK:" "MAIN:" "MATH:" "POSTPONE:"
@@ -211,8 +214,7 @@
     (modify-syntax-entry ?\  " " table)
     (modify-syntax-entry ?\n " " table)
 
-    ;; Strings
-    (modify-syntax-entry ?\" "\"" table)
+    ;; Char quote
     (modify-syntax-entry ?\\ "/" table)
 
     table))
@@ -223,6 +225,8 @@
     ("\\_<\\(#?!\\)\\(\n\\|$\\)" (1 "<") (2 ">"))
     ;; CHARs:
     ("CHAR: \\(.\\)\\( \\|$\\)" (1 "w"))
+    ;; Strings
+    ("\\(\"\\)[^\n\r\f]*\\(\"\\)" (1 "\"") (2 "\""))
     ;; Let and lambda:
     ("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
     ("\\(\\[\\)\\(let\\|wlet\\|let\\*\\)\\( \\|$\\)" (1 "(]"))