steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

db4
Slava Pestov 2008-12-21 20:39:11 -06:00
parent 19a8a9ac9b 31d783c2be
commit 071b3ce365
15 changed files with 310 additions and 161 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
extra/fuel/fuel.factor
View File

@ -122,8 +122,8 @@ M: source-file fuel-pprint path>> fuel-pprint ;
fuel-forget-result
fuel-forget-output ;
: (fuel-end-eval) ( quot -- )
with-string-writer fuel-eval-output set-global fuel-retort
: (fuel-end-eval) ( result -- )
fuel-eval-output set-global fuel-retort
pop-fuel-status ; inline
: (fuel-eval) ( lines -- )
@ -141,39 +141,29 @@ M: source-file fuel-pprint path>> fuel-pprint ;
[ dup "IN: " prepend 1vector (fuel-eval) in set ] when* ; inline
: fuel-eval-in-context ( lines in usings -- )
(fuel-begin-eval) [
(fuel-eval-usings)
(fuel-eval-in)
(fuel-eval)
] (fuel-end-eval) ;
: fuel-begin-eval ( in -- )
(fuel-begin-eval)
(fuel-eval-in)
fuel-retort ;
: fuel-eval ( lines -- )
(fuel-begin-eval) [ (fuel-eval) ] (fuel-end-eval) ; inline
: fuel-end-eval ( -- ) [ ] (fuel-end-eval) ; inline
[ (fuel-eval-usings) (fuel-eval-in) (fuel-eval) ] with-string-writer
(fuel-end-eval) ;
: fuel-run-file ( path -- ) run-file ; inline
! Edit locations
: fuel-get-edit-location ( defspec -- )
where [
first2 [ (normalize-path) ] dip 2array fuel-eval-set-result
] when* ; inline
: fuel-normalize-loc ( seq -- path line )
dup length 1 > [ first2 [ (normalize-path) ] dip ] [ f ] if ; inline
: fuel-xref-desc ( word -- str )
[ name>> ]
[ vocabulary>> [ " (" prepend ")" append ] [ "" ] if* ] bi append ; inline
: fuel-get-edit-location ( defspec -- )
where fuel-normalize-loc 2array fuel-eval-set-result ; inline
: fuel-get-doc-location ( defspec -- )
props>> "help-loc" swap at
fuel-normalize-loc 2array fuel-eval-set-result ;
: fuel-format-xrefs ( seq -- seq )
[ word? ] filter [
[ fuel-xref-desc ]
[ where [ first2 [ (normalize-path) ] dip ] [ f f ] if* ] bi 3array
[ name>> ]
[ vocabulary>> ]
[ where fuel-normalize-loc ] tri 4array
] map [ [ first ] dip first <=> ] sort ; inline
: fuel-callers-xref ( word -- )

11
misc/fuel/README
View File

@ -58,7 +58,8 @@ C-cC-eC-r is the same as C-cC-er)).
- M-. : edit word at point in Emacs
- M-TAB : complete word at point
- C-cC-ev : edit vocabulary (M-x fuel-edit-vocabulary)
- C-cC-ew : edit word (M-x fuel-edit-word)
- C-cC-ew : edit word (M-x fuel-edit-word-at-point)
- C-cC-ed : edit word's doc (M-x fuel-edit-word-at-point)
- C-cr, C-cC-er : eval region
- C-M-r, C-cC-ee : eval region, extending it to definition boundaries
@ -78,6 +79,7 @@ C-cC-eC-r is the same as C-cC-er)).
- TAB : complete word at point
- M-. : edit word at point in Emacs
- C-ca : toggle autodoc mode
- C-cs : toggle stack mode
- C-cv : edit vocabulary
- C-ch : help for word at point
- C-ck : run file
@ -96,5 +98,10 @@ C-cC-eC-r is the same as C-cC-er)).
- SPC/S-SPC : scroll up/down
- TAB/S-TAB : next/previous headline
- C-cz : switch to listener
- q: bury buffer
- q : bury buffer
* In crossref buffers
- TAB/BACKTAB : navigate links
- RET/mouse click : follow link
- q : bury buffer

5
misc/fuel/factor-mode.el
View File

@ -24,8 +24,9 @@
;;; Customization:
(defgroup factor-mode nil
"Major mode for Factor source code"
:group 'fuel)
"Major mode for Factor source code."
:group 'fuel
:group 'languages)
(defcustom factor-mode-use-fuel t
"Whether to use the full FUEL facilities in factor mode.

2
misc/fuel/fuel-autodoc.el
View File

@ -22,7 +22,7 @@
;;; Customization:
(defgroup fuel-autodoc nil
"Options controlling FUEL's autodoc system"
"Options controlling FUEL's autodoc system."
:group 'fuel)
(defcustom fuel-autodoc-minibuffer-font-lock t

18
misc/fuel/fuel-base.el
View File

@ -25,8 +25,8 @@
;;;###autoload
(defgroup fuel nil
"Factor's Ultimate Emacs Library"
:group 'language)
"Factor's Ultimate Emacs Library."
:group 'languages)
;;; Emacs compatibility:
@ -74,12 +74,14 @@
len))
(defsubst fuel--region-to-string (begin &optional end)
(mapconcat 'identity
(split-string (buffer-substring-no-properties begin
(or end (point)))
nil
t)
" "))
(let ((end (or end (point))))
(if (< begin end)
(mapconcat 'identity
(split-string (buffer-substring-no-properties begin end)
nil
t)
" ")
"")))
(defsubst empty-string-p (str) (equal str ""))

2
misc/fuel/fuel-connection.el
View File

@ -134,7 +134,7 @@
(defconst fuel-con--prompt-regex "( .+ ) ")
(defconst fuel-con--eot-marker "<~FUEL~>")
(defconst fuel-con--init-stanza "USE: fuel f fuel-eval")
(defconst fuel-con--init-stanza "USE: fuel fuel-retort")
(defconst fuel-con--comint-finished-regex
(format "^%s$" fuel-con--eot-marker))

69
misc/fuel/fuel-debug.el
View File

@ -14,29 +14,30 @@
;;; Code:
(require 'fuel-base)
(require 'fuel-eval)
(require 'fuel-popup)
(require 'fuel-font-lock)
(require 'fuel-base)
;;; Customization:
(defgroup fuel-debug nil
"Major mode for interaction with the Factor debugger"
"Major mode for interaction with the Factor debugger."
:group 'fuel)
(defcustom fuel-debug-mode-hook nil
"Hook run after `fuel-debug-mode' activates"
"Hook run after `fuel-debug-mode' activates."
:group 'fuel-debug
:type 'hook)
(defcustom fuel-debug-show-short-help t
"Whether to show short help on available keys in debugger"
"Whether to show short help on available keys in debugger."
:group 'fuel-debug
:type 'boolean)
(fuel-font-lock--define-faces
fuel-debug-font-lock font-lock fuel-debug
fuel-font-lock-debug font-lock fuel-debug
((error warning "highlighting errors")
(line variable-name "line numbers in errors/warnings")
(column variable-name "column numbers in errors/warnings")
@ -66,14 +67,14 @@
(defconst fuel-debug--restart-regex "^:\\([0-9]+\\) \\(.+\\)")
(defconst fuel-debug--font-lock-keywords
`((,fuel-debug--error-file-regex . 'fuel-debug-font-lock-error)
(,fuel-debug--error-line-regex 1 'fuel-debug-font-lock-line)
(,fuel-debug--error-cont-regex 1 'fuel-debug-font-lock-column)
(,fuel-debug--restart-regex (1 'fuel-debug-font-lock-restart-number)
(2 'fuel-debug-font-lock-restart-name))
(,fuel-debug--compiler-info-regex 1 'fuel-debug-font-lock-restart-number)
("^\\(Restarts?\\|Loading\\) .+$" . 'fuel-debug-font-lock-info)
("^Error: " . 'fuel-debug-font-lock-error)))
`((,fuel-debug--error-file-regex . 'fuel-font-lock-debug-error)
(,fuel-debug--error-line-regex 1 'fuel-font-lock-debug-line)
(,fuel-debug--error-cont-regex 1 'fuel-font-lock-debug-column)
(,fuel-debug--restart-regex (1 'fuel-font-lock-debug-restart-number)
(2 'fuel-font-lock-debug-restart-name))
(,fuel-debug--compiler-info-regex 1 'fuel-font-lock-debug-restart-number)
("^\\(Restarts?\\|Loading\\) .+$" . 'fuel-font-lock-debug-info)
("^Error: " . 'fuel-font-lock-debug-error)))
(defun fuel-debug--font-lock-setup ()
(set (make-local-variable 'font-lock-defaults)
@ -82,7 +83,8 @@
;;; Debug buffer:
(defvar fuel-debug--buffer nil)
(fuel-popup--define fuel-debug--buffer
"*fuel debug*" 'fuel-debug-mode)
(make-variable-buffer-local
(defvar fuel-debug--last-ret nil))
@ -90,13 +92,6 @@
(make-variable-buffer-local
(defvar fuel-debug--file nil))
(defun fuel-debug--buffer ()
(or (and (buffer-live-p fuel-debug--buffer) fuel-debug--buffer)
(with-current-buffer
(setq fuel-debug--buffer (get-buffer-create "*fuel dbg*"))
(fuel-debug-mode)
(current-buffer))))
(defun fuel-debug--display-retort (ret &optional success-msg no-pop file)
(let ((err (fuel-eval--retort-error ret))
(inhibit-read-only t))
@ -111,16 +106,16 @@
(when err
(fuel-debug--display-restarts err)
(delete-blank-lines)
(newline)
(let ((hstr (fuel-debug--help-string err file)))
(if fuel-debug-show-short-help
(insert "-----------\n" hstr "\n")
(message "%s" hstr))))
(newline))
(let ((hstr (fuel-debug--help-string err file)))
(if fuel-debug-show-short-help
(insert "-----------\n" hstr "\n")
(message "%s" hstr)))
(setq fuel-debug--last-ret ret)
(setq fuel-debug--file file)
(goto-char (point-max))
(font-lock-fontify-buffer)
(when (and err (not no-pop)) (pop-to-buffer fuel-debug--buffer))
(when (and err (not no-pop)) (fuel-popup--display))
(not err))))
(defun fuel-debug--display-output (ret)
@ -179,16 +174,16 @@
(defun fuel-debug-goto-error ()
(interactive)
(let* ((err (or (fuel-debug--buffer-error)
(error "No errors reported")))
(let* ((err (fuel-debug--buffer-error))
(file (or (fuel-debug--buffer-file)
(error "No file associated with error")))
(l/c (fuel-eval--error-line/column err))
(error "No file associated with compilation")))
(l/c (and err (fuel-eval--error-line/column err)))
(line (or (car l/c) 1))
(col (or (cdr l/c) 0)))
(find-file-other-window file)
(goto-line line)
(forward-char col)))
(when line
(goto-line line)
(when col (forward-char col)))))
(defun fuel-debug--read-restart-no ()
(let ((rs (fuel-debug--buffer-restarts)))
@ -224,9 +219,11 @@
(unless (re-search-forward (format "^%s" info) nil t)
(error "%s information not available" info))
(message "Retrieving %s info ..." info)
(unless (fuel-debug--display-retort
(fuel-eval--send/wait `(:fuel ((:factor ,info))))
"" (fuel-debug--buffer-file))
(unless (fuel-debug--display-retort (fuel-eval--send/wait
`(:fuel ((:factor ,info))))
""
nil
(fuel-debug--buffer-file))
(error "Sorry, no %s info available" info))))

19
misc/fuel/fuel-font-lock.el
View File

@ -21,13 +21,24 @@
;;; Faces:
(defgroup fuel-faces nil
"Faces used by FUEL."
:group 'fuel
:group 'faces)
(defmacro fuel-font-lock--defface (face def group doc)
`(defface ,face (face-default-spec ,def)
,(format "Face for %s." doc)
:group ',group
:group 'fuel-faces
:group 'faces))
(put 'fuel-font-lock--defface 'lisp-indent-function 1)
(defmacro fuel-font-lock--make-face (prefix def-prefix group face def doc)
(let ((face (intern (format "%s-%s" prefix face)))
(def (intern (format "%s-%s-face" def-prefix def))))
`(defface ,face (face-default-spec ,def)
,(format "Face for %s." doc)
:group ',group
:group 'faces)))
`(fuel-font-lock--defface ,face ,def ,group ,doc)))
(defmacro fuel-font-lock--define-faces (prefix def-prefix group faces)
(let ((setup (make-symbol (format "%s--faces-setup" prefix))))

25
misc/fuel/fuel-help.el
View File

@ -18,13 +18,14 @@
(require 'fuel-autodoc)
(require 'fuel-completion)
(require 'fuel-font-lock)
(require 'fuel-popup)
(require 'fuel-base)
;;; Customization:
(defgroup fuel-help nil
"Options controlling FUEL's help system"
"Options controlling FUEL's help system."
:group 'fuel)
(defcustom fuel-help-always-ask t
@ -47,10 +48,8 @@
:type 'integer
:group 'fuel-help)
(defface fuel-help-font-lock-headlines '((t (:bold t :weight bold)))
"Face for headlines in help buffers."
:group 'fuel-help
:group 'faces)
(fuel-font-lock--defface fuel-font-lock-help-headlines
'bold fuel-hep "headlines in help buffers")
;;; Help browser history:
@ -81,10 +80,9 @@
;;; Fuel help buffer and internals:
(defun fuel-help--help-buffer ()
(with-current-buffer (get-buffer-create "*fuel help*")
(fuel-help-mode)
(current-buffer)))
(fuel-popup--define fuel-help--buffer
"*fuel help*" 'fuel-help-mode)
(defvar fuel-help--prompt-history nil)
@ -111,7 +109,7 @@
(fuel-help--insert-contents def out))))
(defun fuel-help--insert-contents (def str &optional nopush)
(let ((hb (fuel-help--help-buffer))
(let ((hb (fuel-help--buffer))
(inhibit-read-only t)
(font-lock-verbose nil))
(set-buffer hb)
@ -124,7 +122,7 @@
(kill-region (point-min) (point))
(fuel-help--history-push (cons def (buffer-string)))))
(set-buffer-modified-p nil)
(pop-to-buffer hb)
(fuel-popup--display)
(goto-char (point-min))
(message "%s" def)))
@ -154,7 +152,7 @@
(defconst fuel-help--font-lock-keywords
`(,@fuel-font-lock--font-lock-keywords
(,fuel-help--headlines-regexp . 'fuel-help-font-lock-headlines)))
(,fuel-help--headlines-regexp . 'fuel-font-lock-help-headlines)))
@ -211,7 +209,6 @@ buffer."
(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)
(define-key map "f" 'fuel-help-next)
(define-key map "l" 'fuel-help-previous)
@ -222,6 +219,7 @@ buffer."
(define-key map [(backtab)] 'fuel-help-previous-headline)
(define-key map (kbd "SPC") 'scroll-up)
(define-key map (kbd "S-SPC") 'scroll-down)
(define-key map "\M-." 'fuel-edit-word-at-point)
(define-key map "\C-cz" 'run-factor)
(define-key map "\C-c\C-z" 'run-factor)
map))
@ -245,6 +243,7 @@ buffer."
(fuel-autodoc-mode)
(run-mode-hooks 'fuel-help-mode-hook)
(setq buffer-read-only t))

45
misc/fuel/fuel-listener.el
View File

@ -13,8 +13,9 @@
;;; Code:
(require 'fuel-eval)
(require 'fuel-stack)
(require 'fuel-completion)
(require 'fuel-eval)
(require 'fuel-connection)
(require 'fuel-syntax)
(require 'fuel-base)
@ -25,7 +26,7 @@
;;; Customization:
(defgroup fuel-listener nil
"Interacting with a Factor listener inside Emacs"
"Interacting with a Factor listener inside Emacs."
:group 'fuel)
(defcustom fuel-listener-factor-binary "~/factor/factor"
@ -102,16 +103,9 @@ buffer."
(goto-char (point-max))
(unless seen (error "No prompt found!"))))
;;; Completion support
(defsubst fuel-listener--current-vocab () nil)
(defsubst fuel-listener--usings () nil)
(defun fuel-listener--setup-completion ()
(setq fuel-syntax--current-vocab-function 'fuel-listener--current-vocab)
(setq fuel-syntax--usings-function 'fuel-listener--usings)
(set-syntax-table fuel-syntax--syntax-table))
(defun fuel-listener-nuke ()
(interactive)
(fuel-con--setup-connection fuel-listener--buffer))
;;; Interface: starting fuel listener
@ -128,6 +122,28 @@ buffer."
(pop-to-buffer buf)
(switch-to-buffer buf))))
;;; Completion support
(defsubst fuel-listener--current-vocab () nil)
(defsubst fuel-listener--usings () nil)
(defun fuel-listener--setup-completion ()
(setq fuel-syntax--current-vocab-function 'fuel-listener--current-vocab)
(setq fuel-syntax--usings-function 'fuel-listener--usings)
(set-syntax-table fuel-syntax--syntax-table))
;;; Stack mode support
(defun fuel-listener--stack-region ()
(fuel--region-to-string (if (zerop (fuel-syntax--brackets-depth))
(comint-line-beginning-position)
(1+ (fuel-syntax--brackets-start)))))
(defun fuel-listener--setup-stack-mode ()
(setq fuel-stack--region-function 'fuel-listener--stack-region))
;;; Fuel listener mode:
@ -138,12 +154,15 @@ buffer."
(set (make-local-variable 'comint-prompt-regexp) fuel-con--prompt-regex)
(set (make-local-variable 'comint-use-prompt-regexp) t)
(set (make-local-variable 'comint-prompt-read-only) t)
(fuel-listener--setup-completion))
(set-syntax-table fuel-syntax--syntax-table)
(fuel-listener--setup-completion)
(fuel-listener--setup-stack-mode))
(define-key fuel-listener-mode-map "\C-cz" 'run-factor)
(define-key fuel-listener-mode-map "\C-c\C-z" 'run-factor)
(define-key fuel-listener-mode-map "\C-ca" 'fuel-autodoc-mode)
(define-key fuel-listener-mode-map "\C-ch" 'fuel-help)
(define-key fuel-listener-mode-map "\C-cs" 'fuel-stack-mode)
(define-key fuel-listener-mode-map "\M-." 'fuel-edit-word-at-point)
(define-key fuel-listener-mode-map "\C-cv" 'fuel-edit-vocabulary)
(define-key fuel-listener-mode-map "\C-c\C-v" 'fuel-edit-vocabulary)

29
misc/fuel/fuel-mode.el
View File

@ -135,12 +135,28 @@ buffer in case of errors."
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))))
(fuel-completion--read-word "Edit word: ")))
(cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
(condition-case nil
(fuel--try-edit (fuel-eval--send/wait cmd))
(error (fuel-edit-vocabulary nil word)))))
(defun fuel-edit-word-doc-at-point (&optional arg)
"Opens a new window visiting the documentation file for the word at point.
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-doc-location))))
(condition-case nil
(fuel--try-edit (fuel-eval--send/wait cmd))
(error (when (y-or-n-p (concat "No documentation found. "
"Do you want to open the vocab's "
"doc file? "))
(find-file-other-window
(format "%s-docs.factor"
(file-name-sans-extension (buffer-file-name)))))))))
(defvar fuel-mode--word-history nil)
(defun fuel-edit-word (&optional arg)
@ -152,7 +168,7 @@ offered."
nil
fuel-mode--word-history
arg))
(cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
(cmd `(:fuel* ((:quote ,word) fuel-get-edit-location))))
(fuel--try-edit (fuel-eval--send/wait cmd))))
(defvar fuel--vocabs-prompt-history nil)
@ -183,8 +199,7 @@ With prefix argument, ask for word."
(fuel-syntax-symbol-at-point))))
(when word
(message "Looking up %s's callers ..." word)
(fuel-xref--show-callers word)
(message ""))))
(fuel-xref--show-callers word))))
(defun fuel-show-callees (&optional arg)
"Show a list of callers of word at point.
@ -196,8 +211,7 @@ With prefix argument, ask for word."
(fuel-syntax-symbol-at-point))))
(when word
(message "Looking up %s's callees ..." word)
(fuel-xref--show-callees word)
(message ""))))
(fuel-xref--show-callees word))))
;;; Minor mode definition:
@ -252,6 +266,7 @@ interacting with a factor listener is at your disposal.
(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 ?d 'fuel-edit-word-doc-at-point)
(fuel-mode--key ?e ?e 'fuel-eval-extended-region)
(fuel-mode--key ?e ?l 'fuel-run-file)
(fuel-mode--key ?e ?r 'fuel-eval-region)

60
misc/fuel/fuel-popup.el Normal file
View File

@ -0,0 +1,60 @@
;;; fuel-popup.el -- popup windows
;; 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: Sun Dec 21, 2008 14:37
;;; Comentary:
;; A minor mode to pop up windows and restore configurations
;; afterwards.
;;; Code:
(make-variable-buffer-local
(defvar fuel-popup--created-window nil))
(make-variable-buffer-local
(defvar fuel-popup--selected-window nil))
(defun fuel-popup--display (&optional buffer)
(when buffer (set-buffer buffer))
(let ((selected-window (selected-window))
(buffer (current-buffer)))
(unless (eq selected-window (get-buffer-window buffer))
(let ((windows))
(walk-windows (lambda (w) (push w windows)) nil t)
(prog1 (pop-to-buffer buffer)
(set (make-local-variable 'fuel-popup--created-window)
(unless (memq (selected-window) windows) (selected-window)))
(set (make-local-variable 'fuel-popup--selected-window)
selected-window))))))
(defun fuel-popup--quit ()
(interactive)
(let ((selected fuel-popup--selected-window)
(created fuel-popup--created-window))
(bury-buffer)
(when (eq created (selected-window)) (delete-window created))
(when (window-live-p selected) (select-window selected))))
(define-minor-mode fuel-popup-mode
"Mode for displaying read only stuff"
nil nil
'(("q" . fuel-popup--quit)))
(defmacro fuel-popup--define (fun name mode)
`(defun ,fun ()
(or (get-buffer ,name)
(with-current-buffer (get-buffer-create ,name)
(funcall ,mode)
(fuel-popup-mode)
(current-buffer)))))
(put 'fuel-popup--define 'lisp-indent-function 1)
(provide 'fuel-popup)
;;; fuel-popup.el ends here

24
misc/fuel/fuel-stack.el
View File

@ -17,21 +17,20 @@
(require 'fuel-autodoc)
(require 'fuel-syntax)
(require 'fuel-eval)
(require 'fuel-font-lock)
(require 'fuel-base)
;;; Customization
(defgroup fuel-stack nil
"Customization for FUEL's stack inference engine"
"Customization for FUEL's stack inference engine."
:group 'fuel)
(defface fuel-font-lock-stack-region (face-user-default-spec 'highlight)
"Face used to highlight the region whose stack effect is shown"
:group 'fuel-stack
:group 'faces)
(fuel-font-lock--defface fuel-font-lock-stack-region
'highlight fuel-stack "highlighting the stack effect region")
(defcustom fuel-stack-highlight-period 2
(defcustom fuel-stack-highlight-period 2.0
"Time, in seconds, the region is highlighted when showing its
stack effect.
@ -97,13 +96,20 @@ With prefix argument, use current region instead"
(defvar fuel-stack-mode-string " S"
"Modeline indicator for fuel-stack-mode"))
(make-variable-buffer-local
(defvar fuel-stack--region-function
'(lambda ()
(fuel--region-to-string (1+ (fuel-syntax--beginning-of-sexp-pos))))))
(defun fuel-stack--eldoc ()
(when (looking-at-p " \\|$")
(let* ((r (fuel--region-to-string (1+ (fuel-syntax--beginning-of-sexp-pos))))
(e (fuel-stack--infer-effect/prop r)))
(let* ((r (funcall fuel-stack--region-function))
(e (and r
(not (string-match "^ *$" r))
(fuel-stack--infer-effect/prop r))))
(when e
(if fuel-stack-mode-show-sexp-p
(concat (fuel--shorten-str r 30) ": " e)
(concat (fuel--shorten-str r 30) " -> " e)
e)))))
(define-minor-mode fuel-stack-mode

5
misc/fuel/fuel-syntax.el
View File

@ -277,6 +277,11 @@
(defsubst fuel-syntax--end-of-defun ()
(re-search-forward fuel-syntax--end-of-def-regex nil t))
(defsubst fuel-syntax--end-of-defun-pos ()
(save-excursion
(re-search-forward fuel-syntax--end-of-def-regex nil t)
(point)))
(defconst fuel-syntax--defun-signature-regex
(format "\\(%s\\|%s\\)"
(format ":[^ ]* [^ ]+\\(%s\\)*" fuel-syntax--stack-effect-regex)

117
misc/fuel/fuel-xref.el
View File

@ -13,6 +13,10 @@
;;; Code:
(require 'fuel-eval)
(require 'fuel-syntax)
(require 'fuel-popup)
(require 'fuel-font-lock)
(require 'fuel-base)
(require 'button)
@ -24,13 +28,25 @@
"FUEL's cross-referencing engine."
:group 'fuel)
(defcustom fuel-xref-follow-link-to-word-p t
"Whether, when following a link to a caller, we position the
cursor at the first ocurrence of the used word."
:group 'fuel-xref
:type 'boolean)
(fuel-font-lock--defface fuel-font-lock-xref-link
'link fuel-xref "highlighting links in cross-reference buffers")
(fuel-font-lock--defface fuel-font-lock-xref-vocab
'italic fuel-xref "vocabulary names in cross-reference buffers")
;;; Buttons:
(define-button-type 'fuel-xref--button-type
'action 'fuel-xref--follow-link
'follow-link t
'face 'default)
'face 'fuel-font-lock-xref-link)
(defun fuel-xref--follow-link (button)
(let ((file (button-get button 'file))
@ -39,60 +55,81 @@
(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))))
(let ((word fuel-xref--word))
(find-file-other-window file)
(when (numberp line) (goto-line line))
(when (and word fuel-xref-follow-link-to-word-p)
(and (search-forward word
(fuel-syntax--end-of-defun-pos)
t)
(goto-char (match-beginning 0)))))))
;;; The xref buffer:
(defvar fuel-xref--buffer-name "*fuel xref*")
(fuel-popup--define fuel-xref--buffer
"*fuel xref*" 'fuel-xref-mode)
(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)))))
(make-local-variable (defvar fuel-xref--word nil))
(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)
(defun fuel-xref--title (word cc count)
(let ((cc (if cc "using" "used by")))
(put-text-property 0 (length word) 'font-lock-face 'bold word)
(cond ((zerop count) (format "No known words %s %s" cc word))
((= 1 count) (format "1 word %s %s:" cc word))
(t (format "%s words %s %s:" count cc word)))))
(defun fuel-xref--insert-ref (ref)
(when (and (stringp (first ref))
(stringp (third ref))
(numberp (fourth ref)))
(insert " ")
(insert-text-button (first ref)
:type 'fuel-xref--button-type
'help-echo (format "File: %s (%s)"
(third ref)
(fourth ref))
'file (third ref)
'line (fourth ref))
(when (stringp (second ref))
(insert (format " (in %s)" (second ref))))
(newline)
t))
(defun fuel-xref--fill-buffer (word cc refs)
(let ((inhibit-read-only t)
(count 0))
(with-current-buffer (fuel-xref--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)))))
(when (fuel-xref--insert-ref ref) (setq count (1+ count))))
(goto-char (point-min))
(insert (fuel-xref--title word cc count) "\n\n")
(when (> count 0)
(setq fuel-xref--word (and cc word))
(goto-char (point-max))
(insert "\n" fuel-xref--help-string "\n"))
(goto-char (point-min))
count)))
(defun fuel-xref--fill-and-display (word cc refs)
(let ((count (fuel-xref--fill-buffer word cc refs)))
(if (zerop count)
(error (fuel-xref--title word cc 0))
(message "")
(fuel-popup--display (fuel-xref--buffer)))))
(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))))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(fuel-xref--fill-and-display word t res)))
(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))))
(res (fuel-eval--retort-result (fuel-eval--send/wait cmd))))
(fuel-xref--fill-and-display word nil res)))
;;; Xref mode:
@ -113,7 +150,7 @@
(use-local-map fuel-xref-mode-map)
(setq mode-name "FUEL Xref")
(setq major-mode 'fuel-xref-mode)
(fuel-font-lock--font-lock-setup)
(font-lock-add-keywords nil '(("(in \\(.+\\))" 1 'fuel-font-lock-xref-vocab)))
(setq buffer-read-only t))