Merge branch 'emacs' of http://git.hacks-galore.org/jao/factor into new_ui

extra/fuel/fuel.factor

@@ -4,10 +4,10 @@
 USING: accessors arrays assocs classes classes.tuple
 combinators compiler.units continuations debugger definitions
 eval help io io.files io.pathnames io.streams.string kernel
-lexer listener listener.private make math memoize namespaces
+lexer listener listener.private make math math.order memoize
-parser prettyprint prettyprint.config quotations sequences sets
+namespaces parser prettyprint prettyprint.config quotations
-sorting source-files strings summary tools.vocabs vectors
+sequences sets sorting source-files strings summary tools.vocabs
-vocabs vocabs.loader vocabs.parser ;
+vectors vocabs vocabs.loader vocabs.parser words ;
 
 IN: fuel
 
@@ -166,6 +166,22 @@ M: source-file fuel-pprint path>> fuel-pprint ;
        first2 [ (normalize-path) ] dip 2array fuel-eval-set-result
     ] when* ; inline
 
+: fuel-xref-desc ( word -- str )
+    [ name>> ]
+    [ vocabulary>> [ " (" prepend ")" append ] [ "" ] if* ] bi append ; inline
+
+: fuel-format-xrefs ( seq -- seq )
+    [ word? ] filter [
+        [ fuel-xref-desc ]
+        [ where [ first2 [ (normalize-path) ] dip ] [ f f ] if* ] bi 3array
+    ] map [ [ first ] dip first <=> ] sort ; inline
+
+: fuel-callers-xref ( word -- )
+    usage fuel-format-xrefs fuel-eval-set-result ; inline
+
+: fuel-callees-xref ( word -- )
+    uses fuel-format-xrefs fuel-eval-set-result ; inline
+
 : fuel-get-vocab-location ( vocab -- )
     >vocab-link fuel-get-edit-location ; inline
 

misc/fuel/README

@@ -70,6 +70,9 @@ C-cC-eC-r is the same as C-cC-er)).
  - C-cC-ds : short help word at point
  - C-cC-de : show stack effect of current sexp (with prefix, region)
 
+ - C-cM-<, C-cC-d< : show callers of word at point
+ - C-cM->, C-cC-d> : show callees of word at point
+
 * In the listener:
 
  - TAB : complete word at point

misc/fuel/fuel-help.el

@@ -209,6 +209,7 @@ buffer."
 
 (defvar fuel-help-mode-map
   (let ((map (make-sparse-keymap)))
+    (suppress-keymap map)
     (define-key map "\C-m" 'fuel-help)
     (define-key map "q" 'bury-buffer)
     (define-key map "b" 'fuel-help-previous)
@@ -235,7 +236,7 @@ buffer."
   (kill-all-local-variables)
   (buffer-disable-undo)
   (use-local-map fuel-help-mode-map)
-  (setq mode-name "Factor Help")
+  (setq mode-name "FUEL Help")
   (setq major-mode 'fuel-help-mode)
 
   (fuel-font-lock--font-lock-setup fuel-help--font-lock-keywords t)

misc/fuel/fuel-mode.el

@@ -19,6 +19,7 @@
 (require 'fuel-debug)
 (require 'fuel-eval)
 (require 'fuel-help)
+(require 'fuel-xref)
 (require 'fuel-stack)
 (require 'fuel-autodoc)
 (require 'fuel-font-lock)
@@ -35,11 +36,13 @@
 (defcustom fuel-mode-autodoc-p t
   "Whether `fuel-autodoc-mode' gets enabled by default in factor buffers."
   :group 'fuel-mode
+  :group 'fuel-autodoc
   :type 'boolean)
 
 (defcustom fuel-mode-stack-p nil
   "Whether `fuel-stack-mode' gets enabled by default in factor buffers."
   :group 'fuel-mode
+  :group 'fuel-stack
   :type 'boolean)
 
 
@@ -170,6 +173,32 @@ With prefix argument, refreshes cached vocabulary list."
          (cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t)))
     (fuel--try-edit (fuel-eval--send/wait cmd))))
 
+(defun fuel-show-callers (&optional arg)
+  "Show a list of callers of word at point.
+With prefix argument, ask for word."
+  (interactive "P")
+  (let ((word (if arg (fuel-completion--read-word "Find callers for: "
+                                                  (fuel-syntax-symbol-at-point)
+                                                  fuel-mode--word-history)
+                (fuel-syntax-symbol-at-point))))
+    (when word
+      (message "Looking up %s's callers ..." word)
+      (fuel-xref--show-callers word)
+      (message ""))))
+
+(defun fuel-show-callees (&optional arg)
+  "Show a list of callers of word at point.
+With prefix argument, ask for word."
+  (interactive "P")
+  (let ((word (if arg (fuel-completion--read-word "Find callees for: "
+                                                  (fuel-syntax-symbol-at-point)
+                                                  fuel-mode--word-history)
+                (fuel-syntax-symbol-at-point))))
+    (when word
+      (message "Looking up %s's callees ..." word)
+      (fuel-xref--show-callees word)
+      (message ""))))
+
 
 ;;; Minor mode definition:
 
@@ -219,6 +248,8 @@ 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 "\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)
 
 (fuel-mode--key ?e ?e 'fuel-eval-extended-region)
@@ -228,6 +259,8 @@ interacting with a factor listener is at your disposal.
 (fuel-mode--key ?e ?w 'fuel-edit-word)
 (fuel-mode--key ?e ?x 'fuel-eval-definition)
 
+(fuel-mode--key ?d ?> 'fuel-show-callees)
+(fuel-mode--key ?d ?< 'fuel-show-callers)
 (fuel-mode--key ?d ?a 'fuel-autodoc-mode)
 (fuel-mode--key ?d ?d 'fuel-help)
 (fuel-mode--key ?d ?e 'fuel-stack-effect-sexp)

misc/fuel/fuel-xref.el

@@ -0,0 +1,121 @@
+;;; fuel-xref.el -- showing cross-reference info
+
+;; Copyright (C) 2008 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: Sat Dec 20, 2008 22:00
+
+;;; Comentary:
+
+;; A mode and utilities for showing cross-reference information.
+
+;;; Code:
+
+(require 'fuel-base)
+
+(require 'button)
+
+
+;;; Customization:
+
+(defgroup fuel-xref nil
+  "FUEL's cross-referencing engine."
+  :group 'fuel)
+
+
+;;; Buttons:
+
+(define-button-type 'fuel-xref--button-type
+  'action 'fuel-xref--follow-link
+  'follow-link t
+  'face 'default)
+
+(defun fuel-xref--follow-link (button)
+  (let ((file (button-get button 'file))
+        (line (button-get button 'line)))
+    (when (not file)
+      (error "No file for this ref"))
+    (when (not (file-readable-p file))
+      (error "File '%s' is not readable" file))
+    (find-file-other-window file)
+    (when (numberp line) (goto-line line))))
+
+
+;;; The xref buffer:
+
+(defvar fuel-xref--buffer-name "*fuel xref*")
+
+(defun fuel-xref--get-buffer ()
+  (let ((buffer (get-buffer fuel-xref--buffer-name)))
+    (or (and (buffer-live-p buffer) buffer)
+        (prog1
+            (set-buffer (get-buffer-create fuel-xref--buffer-name))
+          (fuel-xref-mode)))))
+
+(defvar fuel-xref--help-string "(Press RET or click to follow crossrefs)")
+
+(defun fuel-xref--fill-buffer (title refs)
+  (let ((inhibit-read-only t))
+    (with-current-buffer (fuel-xref--get-buffer)
+      (erase-buffer)
+      (insert title "\n\n")
+      (dolist (ref refs)
+        (when (and (first ref) (second ref) (numberp (third ref)))
+          (insert "  ")
+          (insert-text-button (first ref)
+                              :type 'fuel-xref--button-type
+                              'help-echo (format "File: %s (%s)"
+                                                 (second ref)
+                                                 (third ref))
+                              'file (second ref)
+                              'line (third ref))
+          (newline)))
+      (when refs
+        (insert "\n\n" fuel-xref--help-string "\n"))
+      (goto-char (point-min)))))
+
+(defun fuel-xref--show-callers (word)
+  (let* ((cmd `(:fuel* (((:quote ,word) fuel-callers-xref))))
+         (res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
+         (title (format (if res "Callers of '%s':"
+                          "No callers found for '%s'")
+                        word)))
+    (fuel-xref--fill-buffer title res)
+    (pop-to-buffer (fuel-xref--get-buffer))))
+
+(defun fuel-xref--show-callees (word)
+  (let* ((cmd `(:fuel* (((:quote ,word) fuel-callees-xref))))
+         (res (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
+         (title (format (if res "Words called by '%s':"
+                          "No callees found for '%s'")
+                        word)))
+    (fuel-xref--fill-buffer title res)
+    (pop-to-buffer (fuel-xref--get-buffer))))
+
+
+;;; Xref mode:
+
+(defvar fuel-xref-mode-map
+  (let ((map (make-sparse-keymap)))
+    (suppress-keymap map)
+    (set-keymap-parent map button-buffer-map)
+    (define-key map "q" 'bury-buffer)
+    map))
+
+(defun fuel-xref-mode ()
+  "Mode for displaying FUEL cross-reference information.
+\\{fuel-xref-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (buffer-disable-undo)
+  (use-local-map fuel-xref-mode-map)
+  (setq mode-name "FUEL Xref")
+  (setq major-mode 'fuel-xref-mode)
+  (fuel-font-lock--font-lock-setup)
+  (setq buffer-read-only t))
+
+
+(provide 'fuel-xref)
+;;; fuel-xref.el ends here