Merge branch 'master' of git://factorcode.org/git/factor
John Benediktsson
commit
43e12f15e9
|
|
@ -6,14 +6,14 @@ 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
|
||||
parser prettyprint prettyprint.config quotations sequences sets
|
||||
sorting source-files strings tools.vocabs vectors vocabs
|
||||
vocabs.loader vocabs.parser summary ;
|
||||
sorting source-files strings summary tools.vocabs vectors
|
||||
vocabs vocabs.loader vocabs.parser ;
|
||||
|
||||
IN: fuel
|
||||
|
||||
! Evaluation status:
|
||||
|
||||
TUPLE: fuel-status in use ds? restarts ;
|
||||
TUPLE: fuel-status in use restarts ;
|
||||
|
||||
SYMBOL: fuel-status-stack
|
||||
V{ } clone fuel-status-stack set-global
|
||||
|
|
@ -37,22 +37,20 @@ t clone fuel-eval-res-flag set-global
|
|||
f fuel-eval-res-flag set-global ; inline
|
||||
|
||||
: push-fuel-status ( -- )
|
||||
in get use get clone display-stacks? get restarts get-global clone
|
||||
in get use get clone restarts get-global clone
|
||||
fuel-status boa
|
||||
fuel-status-stack get push ;
|
||||
|
||||
: pop-fuel-status ( -- )
|
||||
fuel-status-stack get empty? [
|
||||
fuel-status-stack get pop {
|
||||
[ in>> in set ]
|
||||
[ use>> clone use set ]
|
||||
[ ds?>> display-stacks? swap [ on ] [ off ] if ]
|
||||
[
|
||||
restarts>> fuel-eval-restartable? [ drop ] [
|
||||
clone restarts set-global
|
||||
] if
|
||||
]
|
||||
} cleave
|
||||
fuel-status-stack get pop
|
||||
[ in>> in set ]
|
||||
[ use>> clone use set ]
|
||||
[
|
||||
restarts>> fuel-eval-restartable? [ drop ] [
|
||||
clone restarts set-global
|
||||
] if
|
||||
] tri
|
||||
] unless ;
|
||||
|
||||
|
||||
|
|
@ -112,7 +110,7 @@ M: source-file fuel-pprint path>> fuel-pprint ;
|
|||
error get
|
||||
fuel-eval-result get-global
|
||||
fuel-eval-output get-global
|
||||
3array fuel-pprint flush nl "EOT:" write ;
|
||||
3array fuel-pprint flush nl "<~FUEL~>" write nl flush ;
|
||||
|
||||
: fuel-forget-error ( -- ) f error set-global ; inline
|
||||
: fuel-forget-result ( -- ) f fuel-eval-result set-global ; inline
|
||||
|
|
@ -120,14 +118,13 @@ M: source-file fuel-pprint path>> fuel-pprint ;
|
|||
|
||||
: (fuel-begin-eval) ( -- )
|
||||
push-fuel-status
|
||||
display-stacks? off
|
||||
fuel-forget-error
|
||||
fuel-forget-result
|
||||
fuel-forget-output ;
|
||||
|
||||
: (fuel-end-eval) ( quot -- )
|
||||
with-string-writer fuel-eval-output set-global
|
||||
fuel-retort pop-fuel-status ; inline
|
||||
with-string-writer fuel-eval-output set-global fuel-retort
|
||||
pop-fuel-status ; inline
|
||||
|
||||
: (fuel-eval) ( lines -- )
|
||||
[ [ parse-lines ] with-compilation-unit call ] curry
|
||||
|
|
|
|||
|
|
@ -68,6 +68,7 @@ C-cC-eC-r is the same as C-cC-er)).
|
|||
- C-cC-da : toggle autodoc mode
|
||||
- C-cC-dd : help for word at point
|
||||
- C-cC-ds : short help word at point
|
||||
- C-cC-de : show stack effect of current sexp (with prefix, region)
|
||||
|
||||
* In the listener:
|
||||
|
||||
|
|
|
|||
|
|
@ -94,16 +94,19 @@ code in the buffer."
|
|||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(when (> (fuel-syntax--brackets-depth) 0)
|
||||
(let* ((op (fuel-syntax--brackets-start))
|
||||
(cl (fuel-syntax--brackets-end))
|
||||
(ln (line-number-at-pos))
|
||||
(iop (fuel-syntax--indentation-at op)))
|
||||
(when (> ln (line-number-at-pos op))
|
||||
(if (and (> cl 0)
|
||||
(= (- cl (point)) (current-indentation))
|
||||
(= ln (line-number-at-pos cl)))
|
||||
iop
|
||||
(fuel-syntax--increased-indentation iop)))))))
|
||||
(let* ((bs (fuel-syntax--brackets-start))
|
||||
(be (fuel-syntax--brackets-end))
|
||||
(ln (line-number-at-pos)))
|
||||
(when (> ln (line-number-at-pos bs))
|
||||
(cond ((and (> be 0)
|
||||
(= (- be (point)) (current-indentation))
|
||||
(= ln (line-number-at-pos be)))
|
||||
(fuel-syntax--indentation-at bs))
|
||||
((or (fuel-syntax--is-eol bs)
|
||||
(not (eq ?\ (char-after (1+ bs)))))
|
||||
(fuel-syntax--increased-indentation
|
||||
(fuel-syntax--indentation-at bs)))
|
||||
(t (+ 2 (fuel-syntax--line-offset bs)))))))))
|
||||
|
||||
(defun factor-mode--indent-definition ()
|
||||
(save-excursion
|
||||
|
|
|
|||
|
|
@ -17,6 +17,9 @@
|
|||
(autoload 'run-factor "fuel-listener.el"
|
||||
"Start a Factor listener, or switch to a running one." t)
|
||||
|
||||
(autoload 'switch-to-factor "fuel-listener.el"
|
||||
"Start a Factor listener, or switch to a running one." t)
|
||||
|
||||
(autoload 'fuel-autodoc-mode "fuel-help.el"
|
||||
"Minor mode showing in the minibuffer a synopsis of Factor word at point."
|
||||
t)
|
||||
|
|
|
|||
|
|
@ -0,0 +1,95 @@
|
|||
;;; fuel-autodoc.el -- doc snippets in the echo area
|
||||
|
||||
;; 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 00:50
|
||||
|
||||
;;; Comentary:
|
||||
|
||||
;; Utilities for displaying information automatically in the echo
|
||||
;; area.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-syntax)
|
||||
(require 'fuel-base)
|
||||
|
||||
|
||||
;;; Customization:
|
||||
|
||||
(defgroup fuel-autodoc nil
|
||||
"Options controlling FUEL's autodoc system"
|
||||
:group 'fuel)
|
||||
|
||||
(defcustom fuel-autodoc-minibuffer-font-lock t
|
||||
"Whether to use font lock for info messages in the minibuffer."
|
||||
:group 'fuel-autodoc
|
||||
:type 'boolean)
|
||||
|
||||
|
||||
;;; Autodoc mode:
|
||||
|
||||
(defvar fuel-autodoc--font-lock-buffer
|
||||
(let ((buffer (get-buffer-create " *fuel help minibuffer messages*")))
|
||||
(set-buffer buffer)
|
||||
(fuel-font-lock--font-lock-setup)
|
||||
buffer))
|
||||
|
||||
(defun fuel-autodoc--font-lock-str (str)
|
||||
(set-buffer fuel-autodoc--font-lock-buffer)
|
||||
(erase-buffer)
|
||||
(insert str)
|
||||
(let ((font-lock-verbose nil)) (font-lock-fontify-buffer))
|
||||
(buffer-string))
|
||||
|
||||
(defun fuel-autodoc--word-synopsis (&optional word)
|
||||
(let ((word (or word (fuel-syntax-symbol-at-point)))
|
||||
(fuel-log--inhibit-p t))
|
||||
(when word
|
||||
(let* ((cmd (if (fuel-syntax--in-using)
|
||||
`(:fuel* (,word fuel-vocab-summary) t t)
|
||||
`(:fuel* (((:quote ,word) synopsis :get)) t)))
|
||||
(ret (fuel-eval--send/wait cmd 20))
|
||||
(res (fuel-eval--retort-result ret)))
|
||||
(when (and ret (not (fuel-eval--retort-error ret)) (stringp res))
|
||||
(if fuel-autodoc-minibuffer-font-lock
|
||||
(fuel-autodoc--font-lock-str res)
|
||||
res))))))
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-autodoc--fallback-function nil))
|
||||
|
||||
(defun fuel-autodoc--eldoc-function ()
|
||||
(or (and fuel-autodoc--fallback-function
|
||||
(funcall fuel-autodoc--fallback-function))
|
||||
(fuel-autodoc--word-synopsis)))
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-autodoc-mode-string " A"
|
||||
"Modeline indicator for fuel-autodoc-mode"))
|
||||
|
||||
(define-minor-mode fuel-autodoc-mode
|
||||
"Toggle Fuel's Autodoc mode.
|
||||
With no argument, this command toggles the mode.
|
||||
Non-null prefix argument turns on the mode.
|
||||
Null prefix argument turns off the mode.
|
||||
|
||||
When Autodoc mode is enabled, a synopsis of the word at point is
|
||||
displayed in the minibuffer."
|
||||
:init-value nil
|
||||
:lighter fuel-autodoc-mode-string
|
||||
:group 'fuel-autodoc
|
||||
|
||||
(set (make-local-variable 'eldoc-documentation-function)
|
||||
(when fuel-autodoc-mode 'fuel-autodoc--eldoc-function))
|
||||
(set (make-local-variable 'eldoc-minor-mode-string) nil)
|
||||
(eldoc-mode fuel-autodoc-mode)
|
||||
(message "Fuel Autodoc %s" (if fuel-autodoc-mode "enabled" "disabled")))
|
||||
|
||||
|
||||
(provide 'fuel-autodoc)
|
||||
;;; fuel-autodoc.el ends here
|
||||
|
|
@ -48,6 +48,11 @@
|
|||
(current-buffer)))
|
||||
(complete-with-action action (funcall fun string) string pred))))))
|
||||
|
||||
(when (not (fboundp 'looking-at-p))
|
||||
(defsubst looking-at-p (regexp)
|
||||
(let ((inhibit-changing-match-data t))
|
||||
(looking-at regexp))))
|
||||
|
||||
|
||||
;;; Utilities
|
||||
|
||||
|
|
@ -68,6 +73,14 @@
|
|||
" ")
|
||||
len))
|
||||
|
||||
(defsubst fuel--region-to-string (begin &optional end)
|
||||
(mapconcat 'identity
|
||||
(split-string (buffer-substring-no-properties begin
|
||||
(or end (point)))
|
||||
nil
|
||||
t)
|
||||
" "))
|
||||
|
||||
(defsubst empty-string-p (str) (equal str ""))
|
||||
|
||||
(defun fuel--string-prefix-p (prefix str)
|
||||
|
|
|
|||
|
|
@ -178,7 +178,7 @@ terminates a current completion."
|
|||
Perform completion similar to Emacs' complete-symbol."
|
||||
(interactive)
|
||||
(let* ((end (point))
|
||||
(beg (fuel-syntax--symbol-start))
|
||||
(beg (fuel-syntax--beginning-of-symbol-pos))
|
||||
(prefix (buffer-substring-no-properties beg end))
|
||||
(result (fuel-completion--complete prefix (fuel-syntax--in-using)))
|
||||
(completions (car result))
|
||||
|
|
|
|||
|
|
@ -133,21 +133,27 @@
|
|||
(fuel-con--connection-start-timer conn))))
|
||||
|
||||
(defconst fuel-con--prompt-regex "( .+ ) ")
|
||||
(defconst fuel-con--eot-marker "EOT:")
|
||||
(defconst fuel-con--init-stanza (format "USE: fuel %S write" fuel-con--eot-marker))
|
||||
(defconst fuel-con--eot-marker "<~FUEL~>")
|
||||
(defconst fuel-con--init-stanza "USE: fuel f fuel-eval")
|
||||
|
||||
(defconst fuel-con--comint-finished-regex
|
||||
(format "^%s%s$" fuel-con--eot-marker fuel-con--prompt-regex))
|
||||
(format "^%s$" fuel-con--eot-marker))
|
||||
|
||||
(defun fuel-con--setup-comint ()
|
||||
(comint-redirect-cleanup)
|
||||
(set (make-local-variable 'comint-redirect-insert-matching-regexp) t)
|
||||
(add-hook 'comint-redirect-filter-functions
|
||||
'fuel-con--comint-preoutput-filter nil t)
|
||||
(add-hook 'comint-redirect-hook
|
||||
'fuel-con--comint-redirect-hook nil t))
|
||||
|
||||
(defadvice comint-redirect-setup (after fuel-con--advice activate)
|
||||
(setq comint-redirect-finished-regexp fuel-con--comint-finished-regex))
|
||||
|
||||
(defun fuel-con--comint-preoutput-filter (str)
|
||||
(when (string-match fuel-con--comint-finished-regex str)
|
||||
(setq comint-redirect-finished-regexp fuel-con--prompt-regex))
|
||||
str)
|
||||
|
||||
|
||||
;;; Requests handling:
|
||||
|
||||
|
|
|
|||
|
|
@ -26,12 +26,13 @@
|
|||
(cond ((null sexp) "f")
|
||||
((eq sexp t) "t")
|
||||
((or (stringp sexp) (numberp sexp)) (format "%S" sexp))
|
||||
((vectorp sexp) (cons :quotation (append sexp nil)))
|
||||
((vectorp sexp) (factor (cons :quotation (append sexp nil))))
|
||||
((listp sexp)
|
||||
(case (car sexp)
|
||||
(:array (factor--seq 'V{ '} (cdr sexp)))
|
||||
(:quote (format "\\ %s" (factor `(:factor ,(cadr sexp)))))
|
||||
(:quotation (factor--seq '\[ '\] (cdr sexp)))
|
||||
(:using (factor `(USING: ,@(cdr sexp) :end)))
|
||||
(:factor (format "%s" (mapconcat 'identity (cdr sexp) " ")))
|
||||
(:fuel (factor--fuel-factor (cons :rs (cdr sexp))))
|
||||
(:fuel* (factor--fuel-factor (cons :nrs (cdr sexp))))
|
||||
|
|
@ -43,6 +44,7 @@
|
|||
(:in (fuel-syntax--current-vocab))
|
||||
(:usings `(:array ,@(fuel-syntax--usings)))
|
||||
(:get 'fuel-eval-set-result)
|
||||
(:end '\;)
|
||||
(t `(:factor ,(symbol-name sexp))))))
|
||||
((symbolp sexp) (symbol-name sexp))))
|
||||
|
||||
|
|
|
|||
|
|
@ -15,6 +15,7 @@
|
|||
;;; Code:
|
||||
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-autodoc)
|
||||
(require 'fuel-completion)
|
||||
(require 'fuel-font-lock)
|
||||
(require 'fuel-base)
|
||||
|
|
@ -26,11 +27,6 @@
|
|||
"Options controlling FUEL's help system"
|
||||
:group 'fuel)
|
||||
|
||||
(defcustom fuel-help-minibuffer-font-lock t
|
||||
"Whether to use font lock for info messages in the minibuffer."
|
||||
:group 'fuel-help
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom fuel-help-always-ask t
|
||||
"When enabled, always ask for confirmation in help prompts."
|
||||
:type 'boolean
|
||||
|
|
@ -56,58 +52,6 @@
|
|||
:group 'fuel-help
|
||||
:group 'faces)
|
||||
|
||||
|
||||
;;; Autodoc mode:
|
||||
|
||||
(defvar fuel-help--font-lock-buffer
|
||||
(let ((buffer (get-buffer-create " *fuel help minibuffer messages*")))
|
||||
(set-buffer buffer)
|
||||
(fuel-font-lock--font-lock-setup)
|
||||
buffer))
|
||||
|
||||
(defun fuel-help--font-lock-str (str)
|
||||
(set-buffer fuel-help--font-lock-buffer)
|
||||
(erase-buffer)
|
||||
(insert str)
|
||||
(let ((font-lock-verbose nil)) (font-lock-fontify-buffer))
|
||||
(buffer-string))
|
||||
|
||||
(defun fuel-help--word-synopsis (&optional word)
|
||||
(let ((word (or word (fuel-syntax-symbol-at-point)))
|
||||
(fuel-log--inhibit-p t))
|
||||
(when word
|
||||
(let* ((cmd (if (fuel-syntax--in-using)
|
||||
`(:fuel* (,word fuel-vocab-summary) t t)
|
||||
`(:fuel* (((:quote ,word) synopsis :get)) t)))
|
||||
(ret (fuel-eval--send/wait cmd 20))
|
||||
(res (fuel-eval--retort-result ret)))
|
||||
(when (and ret (not (fuel-eval--retort-error ret)) (stringp res))
|
||||
(if fuel-help-minibuffer-font-lock
|
||||
(fuel-help--font-lock-str res)
|
||||
res))))))
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-autodoc-mode-string " A"
|
||||
"Modeline indicator for fuel-autodoc-mode"))
|
||||
|
||||
(define-minor-mode fuel-autodoc-mode
|
||||
"Toggle Fuel's Autodoc mode.
|
||||
With no argument, this command toggles the mode.
|
||||
Non-null prefix argument turns on the mode.
|
||||
Null prefix argument turns off the mode.
|
||||
|
||||
When Autodoc mode is enabled, a synopsis of the word at point is
|
||||
displayed in the minibuffer."
|
||||
:init-value nil
|
||||
:lighter fuel-autodoc-mode-string
|
||||
:group 'fuel
|
||||
|
||||
(set (make-local-variable 'eldoc-documentation-function)
|
||||
(when fuel-autodoc-mode 'fuel-help--word-synopsis))
|
||||
(set (make-local-variable 'eldoc-minor-mode-string) nil)
|
||||
(eldoc-mode fuel-autodoc-mode)
|
||||
(message "Fuel Autodoc %s" (if fuel-autodoc-mode "enabled" "disabled")))
|
||||
|
||||
|
||||
;;; Help browser history:
|
||||
|
||||
|
|
@ -116,8 +60,6 @@ displayed in the minibuffer."
|
|||
(make-ring fuel-help-history-cache-size) ; previous
|
||||
(make-ring fuel-help-history-cache-size))) ; next
|
||||
|
||||
(defvar fuel-help--history-idx 0)
|
||||
|
||||
(defun fuel-help--history-push (term)
|
||||
(when (and (car fuel-help--history)
|
||||
(not (string= (caar fuel-help--history) (car term))))
|
||||
|
|
|
|||
|
|
@ -76,6 +76,7 @@ buffer."
|
|||
(make-comint-in-buffer "fuel listener" (current-buffer) factor nil
|
||||
"-run=listener" (format "-i=%s" image))
|
||||
(fuel-listener--wait-for-prompt 10000)
|
||||
(fuel-con--setup-connection (current-buffer))
|
||||
(fuel-con--send-string/wait (current-buffer)
|
||||
fuel-con--init-stanza
|
||||
'(lambda (s) (message "FUEL listener up and running!"))
|
||||
|
|
@ -130,10 +131,12 @@ buffer."
|
|||
|
||||
;;; Fuel listener mode:
|
||||
|
||||
;;;###autoload
|
||||
(define-derived-mode fuel-listener-mode comint-mode "Fuel Listener"
|
||||
"Major mode for interacting with an inferior Factor listener process.
|
||||
\\{fuel-listener-mode-map}"
|
||||
(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))
|
||||
|
||||
|
|
|
|||
|
|
@ -14,15 +14,16 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'factor-mode)
|
||||
(require 'fuel-base)
|
||||
(require 'fuel-syntax)
|
||||
(require 'fuel-font-lock)
|
||||
(require 'fuel-debug)
|
||||
(require 'fuel-help)
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-completion)
|
||||
(require 'fuel-listener)
|
||||
(require 'fuel-completion)
|
||||
(require 'fuel-debug)
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-help)
|
||||
(require 'fuel-stack)
|
||||
(require 'fuel-autodoc)
|
||||
(require 'fuel-font-lock)
|
||||
(require 'fuel-syntax)
|
||||
(require 'fuel-base)
|
||||
|
||||
|
||||
;;; Customization:
|
||||
|
|
@ -32,7 +33,12 @@
|
|||
:group 'fuel)
|
||||
|
||||
(defcustom fuel-mode-autodoc-p t
|
||||
"Whether `fuel-autodoc-mode' gets enable by default in fuel buffers."
|
||||
"Whether `fuel-autodoc-mode' gets enabled by default in factor buffers."
|
||||
:group 'fuel-mode
|
||||
:type 'boolean)
|
||||
|
||||
(defcustom fuel-mode-stack-p nil
|
||||
"Whether `fuel-stack-mode' gets enabled by default in factor buffers."
|
||||
:group 'fuel-mode
|
||||
:type 'boolean)
|
||||
|
||||
|
|
@ -74,7 +80,7 @@ With prefix argument, ask for the file to run."
|
|||
|
||||
(defun fuel-eval-region (begin end &optional arg)
|
||||
"Sends region to Fuel's listener for evaluation.
|
||||
Unless called with a prefix, switchs to the compilation results
|
||||
Unless called with a prefix, switches to the compilation results
|
||||
buffer in case of errors."
|
||||
(interactive "r\nP")
|
||||
(let* ((lines (split-string (buffer-substring-no-properties begin end)
|
||||
|
|
@ -90,9 +96,9 @@ buffer in case of errors."
|
|||
(buffer-file-name))))
|
||||
|
||||
(defun fuel-eval-extended-region (begin end &optional arg)
|
||||
"Sends region extended outwards to nearest definitions,
|
||||
"Sends region, extended outwards to nearest definition,
|
||||
to Fuel's listener for evaluation.
|
||||
Unless called with a prefix, switchs to the compilation results
|
||||
Unless called with a prefix, switches to the compilation results
|
||||
buffer in case of errors."
|
||||
(interactive "r\nP")
|
||||
(fuel-eval-region (save-excursion (goto-char begin) (mark-defun) (point))
|
||||
|
|
@ -101,7 +107,7 @@ buffer in case of errors."
|
|||
|
||||
(defun fuel-eval-definition (&optional arg)
|
||||
"Sends definition around point to Fuel's listener for evaluation.
|
||||
Unless called with a prefix, switchs to the compilation results
|
||||
Unless called with a prefix, switches to the compilation results
|
||||
buffer in case of errors."
|
||||
(interactive "P")
|
||||
(save-excursion
|
||||
|
|
@ -189,7 +195,10 @@ interacting with a factor listener is at your disposal.
|
|||
:keymap fuel-mode-map
|
||||
|
||||
(setq fuel-autodoc-mode-string "/A")
|
||||
(when fuel-mode-autodoc-p (fuel-autodoc-mode fuel-mode)))
|
||||
(when fuel-mode-autodoc-p (fuel-autodoc-mode fuel-mode))
|
||||
|
||||
(setq fuel-stack-mode-string "/S")
|
||||
(when fuel-mode-stack-p (fuel-stack-mode fuel-mode)))
|
||||
|
||||
|
||||
;;; Keys:
|
||||
|
|
@ -221,6 +230,7 @@ interacting with a factor listener is at your disposal.
|
|||
|
||||
(fuel-mode--key ?d ?a 'fuel-autodoc-mode)
|
||||
(fuel-mode--key ?d ?d 'fuel-help)
|
||||
(fuel-mode--key ?d ?e 'fuel-stack-effect-sexp)
|
||||
(fuel-mode--key ?d ?s 'fuel-help-short)
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -0,0 +1,132 @@
|
|||
;;; fuel-stack.el -- stack inference help
|
||||
|
||||
;; 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 01:08
|
||||
|
||||
;;; Comentary:
|
||||
|
||||
;; Utilities and a minor mode to show inferred stack effects in the
|
||||
;; echo area.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-autodoc)
|
||||
(require 'fuel-syntax)
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-base)
|
||||
|
||||
|
||||
;;; Customization
|
||||
|
||||
(defgroup fuel-stack nil
|
||||
"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)
|
||||
|
||||
(defcustom fuel-stack-highlight-period 2
|
||||
"Time, in seconds, the region is highlighted when showing its
|
||||
stack effect.
|
||||
|
||||
Set it to 0 to disable highlighting."
|
||||
:group 'fuel-stack
|
||||
:type 'float)
|
||||
|
||||
(defcustom fuel-stack-mode-show-sexp-p t
|
||||
"Whether to show in the echo area the sexp together with its stack effect."
|
||||
:group 'fuel-stack
|
||||
:type 'boolean)
|
||||
|
||||
|
||||
;;; Querying for stack effects
|
||||
|
||||
(defun fuel-stack--infer-effect (str)
|
||||
(let ((cmd `(:fuel*
|
||||
((:using stack-checker effects)
|
||||
([ (:factor ,str) ] infer effect>string :get)))))
|
||||
(fuel-eval--retort-result (fuel-eval--send/wait cmd 500))))
|
||||
|
||||
(defsubst fuel-stack--infer-effect/prop (str)
|
||||
(let ((e (fuel-stack--infer-effect str)))
|
||||
(when e
|
||||
(put-text-property 0 (length e) 'face 'factor-font-lock-stack-effect e))
|
||||
e))
|
||||
|
||||
(defvar fuel-stack--overlay
|
||||
(let ((overlay (make-overlay 0 0)))
|
||||
(overlay-put overlay 'face 'fuel-font-lock-stack-region)
|
||||
(delete-overlay overlay)
|
||||
overlay))
|
||||
|
||||
(defun fuel-stack-effect-region (begin end)
|
||||
"Displays the inferred stack effect of the code in current region."
|
||||
(interactive "r")
|
||||
(when (> fuel-stack-highlight-period 0)
|
||||
(move-overlay fuel-stack--overlay begin end))
|
||||
(condition-case nil
|
||||
(let* ((str (fuel--region-to-string begin end))
|
||||
(effect (fuel-stack--infer-effect/prop str)))
|
||||
(if effect (message "%s" effect)
|
||||
(message "Couldn't infer effect for '%s'"
|
||||
(fuel--shorten-region begin end 60)))
|
||||
(sit-for fuel-stack-highlight-period))
|
||||
(error))
|
||||
(delete-overlay fuel-stack--overlay))
|
||||
|
||||
(defun fuel-stack-effect-sexp (&optional arg)
|
||||
"Displays the inferred stack effect for the current sexp.
|
||||
With prefix argument, use current region instead"
|
||||
(interactive "P")
|
||||
(if arg
|
||||
(call-interactively 'fuel-stack-effect-region)
|
||||
(fuel-stack-effect-region (1+ (fuel-syntax--beginning-of-sexp-pos))
|
||||
(if (looking-at-p ";") (point)
|
||||
(fuel-syntax--end-of-symbol-pos)))))
|
||||
|
||||
|
||||
;;; Stack mode:
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-stack-mode-string " S"
|
||||
"Modeline indicator for fuel-stack-mode"))
|
||||
|
||||
(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)))
|
||||
(when e
|
||||
(if fuel-stack-mode-show-sexp-p
|
||||
(concat (fuel--shorten-str r 30) ": " e)
|
||||
e)))))
|
||||
|
||||
(define-minor-mode fuel-stack-mode
|
||||
"Toggle Fuel's Stack mode.
|
||||
With no argument, this command toggles the mode.
|
||||
Non-null prefix argument turns on the mode.
|
||||
Null prefix argument turns off the mode.
|
||||
|
||||
When Stack mode is enabled, inferred stack effects for current
|
||||
sexp are automatically displayed in the echo area."
|
||||
:init-value nil
|
||||
:lighter fuel-stack-mode-string
|
||||
:group 'fuel-stack
|
||||
|
||||
(setq fuel-autodoc--fallback-function
|
||||
(when fuel-stack-mode 'fuel-stack--eldoc))
|
||||
(set (make-local-variable 'eldoc-minor-mode-string) nil)
|
||||
(unless fuel-autodoc-mode
|
||||
(set (make-local-variable 'eldoc-documentation-function)
|
||||
(when fuel-stack-mode 'fuel-stack--eldoc))
|
||||
(eldoc-mode fuel-stack-mode)
|
||||
(message "Fuel Stack Autodoc %s" (if fuel-stack-mode "enabled" "disabled"))))
|
||||
|
||||
|
||||
(provide 'fuel-stack)
|
||||
;;; fuel-stack.el ends here
|
||||
|
|
@ -19,18 +19,16 @@
|
|||
|
||||
(defun fuel-syntax--beginning-of-symbol ()
|
||||
"Move point to the beginning of the current symbol."
|
||||
(while (eq (char-before) ?:) (backward-char))
|
||||
(skip-syntax-backward "w_"))
|
||||
(skip-syntax-backward "w_()"))
|
||||
|
||||
(defsubst fuel-syntax--symbol-start ()
|
||||
(defsubst fuel-syntax--beginning-of-symbol-pos ()
|
||||
(save-excursion (fuel-syntax--beginning-of-symbol) (point)))
|
||||
|
||||
(defun fuel-syntax--end-of-symbol ()
|
||||
"Move point to the end of the current symbol."
|
||||
(skip-syntax-forward "w_")
|
||||
(while (looking-at ":") (forward-char)))
|
||||
(skip-syntax-forward "w_()"))
|
||||
|
||||
(defsubst fuel-syntax--symbol-end ()
|
||||
(defsubst fuel-syntax--end-of-symbol-pos ()
|
||||
(save-excursion (fuel-syntax--end-of-symbol) (point)))
|
||||
|
||||
(put 'factor-symbol 'end-op 'fuel-syntax--end-of-symbol)
|
||||
|
|
@ -180,6 +178,10 @@
|
|||
(" \\(!\\)" (1 "<"))
|
||||
("^\\(!\\)" (1 "<"))
|
||||
("\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
|
||||
("\\(\\[\\)\\(let\\|wlet\\|let\\*\\)\\( \\|$\\)" (1 "(]"))
|
||||
("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|"))
|
||||
(" \\(|\\) " (1 "(|"))
|
||||
(" \\(|\\)$" (1 ")"))
|
||||
("\\([[({]\\)\\([^ \"\n]\\)" (1 "_") (2 "_"))
|
||||
("\\([^ \"\n]\\)\\([])}]\\)" (1 "_") (2 "_"))))
|
||||
|
||||
|
|
@ -215,16 +217,44 @@
|
|||
(looking-at fuel-syntax--end-of-def-regex))
|
||||
|
||||
(defsubst fuel-syntax--looking-at-emptiness ()
|
||||
(looking-at "^[ \t]*$"))
|
||||
(looking-at "^[ ]*$\\|$"))
|
||||
|
||||
(defsubst fuel-syntax--is-eol (pos)
|
||||
(save-excursion
|
||||
(goto-char (1+ pos))
|
||||
(fuel-syntax--looking-at-emptiness)))
|
||||
|
||||
(defsubst fuel-syntax--line-offset (pos)
|
||||
(- pos (save-excursion
|
||||
(goto-char pos)
|
||||
(beginning-of-line)
|
||||
(point))))
|
||||
|
||||
(defun fuel-syntax--previous-non-blank ()
|
||||
(forward-line -1)
|
||||
(while (and (not (bobp)) (fuel-syntax--looking-at-emptiness))
|
||||
(forward-line -1)))
|
||||
|
||||
(defun fuel-syntax--beginning-of-block-pos ()
|
||||
(save-excursion
|
||||
(if (> (fuel-syntax--brackets-depth) 0)
|
||||
(fuel-syntax--brackets-start)
|
||||
(fuel-syntax--beginning-of-defun)
|
||||
(point))))
|
||||
|
||||
(defun fuel-syntax--at-setter-line ()
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(if (not (fuel-syntax--looking-at-emptiness))
|
||||
(re-search-forward fuel-syntax--setter-regex (line-end-position) t)
|
||||
(forward-line -1)
|
||||
(or (fuel-syntax--at-constructor-line)
|
||||
(fuel-syntax--at-setter-line)))))
|
||||
(when (re-search-forward fuel-syntax--setter-regex
|
||||
(line-end-position)
|
||||
t)
|
||||
(let* ((to (match-beginning 0))
|
||||
(from (fuel-syntax--beginning-of-block-pos)))
|
||||
(goto-char from)
|
||||
(let ((depth (fuel-syntax--brackets-depth)))
|
||||
(and (or (re-search-forward fuel-syntax--constructor-regex to t)
|
||||
(re-search-forward fuel-syntax--setter-regex to t))
|
||||
(= depth (fuel-syntax--brackets-depth))))))))
|
||||
|
||||
(defun fuel-syntax--at-constructor-line ()
|
||||
(save-excursion
|
||||
|
|
@ -247,6 +277,25 @@
|
|||
(defsubst fuel-syntax--end-of-defun ()
|
||||
(re-search-forward fuel-syntax--end-of-def-regex nil t))
|
||||
|
||||
(defconst fuel-syntax--defun-signature-regex
|
||||
(format "\\(%s\\|%s\\)"
|
||||
(format ":[^ ]* [^ ]+\\(%s\\)*" fuel-syntax--stack-effect-regex)
|
||||
"M[^:]*: [^ ]+ [^ ]+"))
|
||||
|
||||
(defun fuel-syntax--beginning-of-body ()
|
||||
(let ((p (point)))
|
||||
(and (fuel-syntax--beginning-of-defun)
|
||||
(re-search-forward fuel-syntax--defun-signature-regex p t)
|
||||
(not (re-search-forward fuel-syntax--end-of-def-regex p t)))))
|
||||
|
||||
(defun fuel-syntax--beginning-of-sexp ()
|
||||
(if (> (fuel-syntax--brackets-depth) 0)
|
||||
(goto-char (fuel-syntax--brackets-start))
|
||||
(fuel-syntax--beginning-of-body)))
|
||||
|
||||
(defsubst fuel-syntax--beginning-of-sexp-pos ()
|
||||
(save-excursion (fuel-syntax--beginning-of-sexp) (point)))
|
||||
|
||||
|
||||
;;; USING/IN:
|
||||
|
||||
|
|
|
|||
Loading…
Reference in New Issue