Merge branch 'emacs' of http://git.hacks-galore.org/jao/factor
Slava Pestov
commit
e6802a4d24
|
|
@ -1,12 +1,13 @@
|
|||
! Copyright (C) 2008 Jose Antonio Ortega Ruiz.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
|
||||
USING: accessors arrays classes classes.tuple compiler.units
|
||||
combinators continuations debugger definitions eval help io
|
||||
io.files io.pathnames io.streams.string kernel lexer listener
|
||||
listener.private make math namespaces parser prettyprint
|
||||
prettyprint.config quotations sequences strings source-files
|
||||
tools.vocabs vectors vocabs vocabs.loader ;
|
||||
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
|
||||
parser prettyprint prettyprint.config quotations sequences sets
|
||||
sorting source-files strings tools.vocabs vectors vocabs
|
||||
vocabs.loader ;
|
||||
|
||||
IN: fuel
|
||||
|
||||
|
|
@ -88,6 +89,14 @@ SYMBOL: :restarts
|
|||
M: condition fuel-pprint
|
||||
[ error>> ] [ fuel-restarts ] bi 2array condition prefix fuel-pprint ;
|
||||
|
||||
M: lexer-error fuel-pprint
|
||||
{
|
||||
[ line>> ]
|
||||
[ column>> ]
|
||||
[ line-text>> ]
|
||||
[ fuel-restarts ]
|
||||
} cleave 4array lexer-error prefix fuel-pprint ;
|
||||
|
||||
M: source-file-error fuel-pprint
|
||||
[ file>> ] [ error>> ] bi 2array source-file-error prefix
|
||||
fuel-pprint ;
|
||||
|
|
@ -159,8 +168,24 @@ M: source-file fuel-pprint path>> fuel-pprint ;
|
|||
: fuel-get-vocab-location ( vocab -- )
|
||||
>vocab-link fuel-get-edit-location ;
|
||||
|
||||
: (fuel-get-vocabs) ( -- seq )
|
||||
all-vocabs-seq [ vocab-name ] map ; inline
|
||||
|
||||
: fuel-get-vocabs ( -- )
|
||||
all-vocabs-seq [ vocab-name ] map fuel-eval-set-result ; inline
|
||||
(fuel-get-vocabs) fuel-eval-set-result ;
|
||||
|
||||
MEMO: (fuel-vocab-words) ( name -- seq )
|
||||
>vocab-link words [ name>> ] map ;
|
||||
|
||||
: fuel-vocabs-words ( names/f -- seq )
|
||||
[ (fuel-get-vocabs) ] unless* prune
|
||||
[ (fuel-vocab-words) ] map concat natural-sort ;
|
||||
|
||||
: (fuel-get-words) ( prefix names/f -- seq )
|
||||
fuel-vocabs-words swap [ drop-prefix nip length 0 = ] curry filter ;
|
||||
|
||||
: fuel-get-words ( prefix names -- )
|
||||
(fuel-get-words) fuel-eval-set-result ; inline
|
||||
|
||||
: fuel-run-file ( path -- ) run-file ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -56,6 +56,7 @@ the same as C-cz)).
|
|||
- C-co : cycle between code, tests and docs factor files
|
||||
|
||||
- M-. : edit word at point in Emacs (also in listener)
|
||||
- M-TAB : complete word at point
|
||||
- C-cC-ev : edit vocabulary
|
||||
|
||||
- C-cr, C-cC-er : eval region
|
||||
|
|
|
|||
|
|
@ -84,8 +84,7 @@ code in the buffer."
|
|||
(set (make-local-variable 'beginning-of-defun-function)
|
||||
'fuel-syntax--beginning-of-defun)
|
||||
(set (make-local-variable 'end-of-defun-function) 'fuel-syntax--end-of-defun)
|
||||
(set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
|
||||
(fuel-syntax--enable-usings))
|
||||
(set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil))
|
||||
|
||||
|
||||
;;; Indentation:
|
||||
|
|
|
|||
|
|
@ -61,5 +61,12 @@
|
|||
|
||||
(defsubst empty-string-p (str) (equal str ""))
|
||||
|
||||
(defun fuel--respecting-message (format &rest format-args)
|
||||
"Display TEXT as a message, without hiding any minibuffer contents."
|
||||
(let ((text (format " [%s]" (apply #'format format format-args))))
|
||||
(if (minibuffer-window-active-p (minibuffer-window))
|
||||
(minibuffer-message text)
|
||||
(message "%s" text))))
|
||||
|
||||
(provide 'fuel-base)
|
||||
;;; fuel-base.el ends here
|
||||
|
|
|
|||
|
|
@ -0,0 +1,173 @@
|
|||
;;; fuel-completion.el -- completion utilities
|
||||
|
||||
;; 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 14, 2008 21:17
|
||||
|
||||
;;; Comentary:
|
||||
|
||||
;; Code completion utilities.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-base)
|
||||
(require 'fuel-syntax)
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-log)
|
||||
|
||||
|
||||
;;; Vocabs dictionary:
|
||||
|
||||
(defvar fuel-completion--vocabs nil)
|
||||
|
||||
(defun fuel-completion--vocabs (&optional reload)
|
||||
(when (or reload (not fuel-completion--vocabs))
|
||||
(fuel--respecting-message "Retrieving vocabs list")
|
||||
(let ((fuel-log--inhibit-p t))
|
||||
(setq fuel-completion--vocabs
|
||||
(fuel-eval--retort-result
|
||||
(fuel-eval--send/wait '(:fuel* (fuel-get-vocabs) "fuel" (:array)))))))
|
||||
fuel-completion--vocabs)
|
||||
|
||||
(defsubst fuel-completion--words (prefix vocabs)
|
||||
(fuel-eval--retort-result
|
||||
(fuel-eval--send/wait `(:fuel* (,prefix V{ ,@vocabs } fuel-get-words) t ,vocabs))))
|
||||
|
||||
|
||||
;;; Completions window handling, heavily inspired in slime's:
|
||||
|
||||
(defvar fuel-completion--comp-buffer "*Completions*")
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-completion--window-cfg nil
|
||||
"Window configuration before we show the *Completions* buffer.
|
||||
This is buffer local in the buffer where the completion is
|
||||
performed."))
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-completion--completions-window nil
|
||||
"The window displaying *Completions* after saving window configuration.
|
||||
If this window is no longer active or displaying the completions
|
||||
buffer then we can ignore `fuel-completion--window-cfg'."))
|
||||
|
||||
(defun fuel-completion--maybe-save-window-configuration ()
|
||||
"Maybe save the current window configuration.
|
||||
Return true if the configuration was saved."
|
||||
(unless (or fuel-completion--window-cfg
|
||||
(get-buffer-window fuel-completion--comp-buffer))
|
||||
(setq fuel-completion--window-cfg
|
||||
(current-window-configuration))
|
||||
t))
|
||||
|
||||
(defun fuel-completion--delay-restoration ()
|
||||
(add-hook 'pre-command-hook
|
||||
'fuel-completion--maybe-restore-window-configuration
|
||||
nil t))
|
||||
|
||||
(defun fuel-completion--forget-window-configuration ()
|
||||
(setq fuel-completion--window-cfg nil)
|
||||
(setq fuel-completion--completions-window nil))
|
||||
|
||||
(defun fuel-completion--restore-window-configuration ()
|
||||
"Restore the window config if available."
|
||||
(remove-hook 'pre-command-hook
|
||||
'fuel-completion--maybe-restore-window-configuration)
|
||||
(when (and fuel-completion--window-cfg
|
||||
(fuel-completion--window-active-p))
|
||||
(save-excursion
|
||||
(set-window-configuration fuel-completion--window-cfg))
|
||||
(setq fuel-completion--window-cfg nil)
|
||||
(when (buffer-live-p fuel-completion--comp-buffer)
|
||||
(kill-buffer fuel-completion--comp-buffer))))
|
||||
|
||||
(defun fuel-completion--maybe-restore-window-configuration ()
|
||||
"Restore the window configuration, if the following command
|
||||
terminates a current completion."
|
||||
(remove-hook 'pre-command-hook
|
||||
'fuel-completion--maybe-restore-window-configuration)
|
||||
(condition-case err
|
||||
(cond ((find last-command-char "()\"'`,# \r\n:")
|
||||
(fuel-completion--restore-window-configuration))
|
||||
((not (fuel-completion--window-active-p))
|
||||
(fuel-completion--forget-window-configuration))
|
||||
(t (fuel-completion--delay-restoration)))
|
||||
(error
|
||||
;; Because this is called on the pre-command-hook, we mustn't let
|
||||
;; errors propagate.
|
||||
(message "Error in fuel-completion--restore-window-configuration: %S" err))))
|
||||
|
||||
(defun fuel-completion--window-active-p ()
|
||||
"Is the completion window currently active?"
|
||||
(and (window-live-p fuel-completion--completions-window)
|
||||
(equal (buffer-name (window-buffer fuel-completion--completions-window))
|
||||
fuel-completion--comp-buffer)))
|
||||
|
||||
(defun fuel-completion--display-comp-list (completions base)
|
||||
(let ((savedp (fuel-completion--maybe-save-window-configuration)))
|
||||
(with-output-to-temp-buffer fuel-completion--comp-buffer
|
||||
(display-completion-list completions)
|
||||
(let ((offset (- (point) 1 (length base))))
|
||||
(with-current-buffer standard-output
|
||||
(setq completion-base-size offset)
|
||||
(set-syntax-table fuel-syntax--syntax-table))))
|
||||
(when savedp
|
||||
(setq fuel-completion--completions-window
|
||||
(get-buffer-window fuel-completion--comp-buffer)))))
|
||||
|
||||
(defun fuel-completion--display-or-scroll (completions base)
|
||||
(cond ((and (eq last-command this-command) (fuel-completion--window-active-p))
|
||||
(fuel-completion--scroll-completions))
|
||||
(t (fuel-completion--display-comp-list completions base)))
|
||||
(fuel-completion--delay-restoration))
|
||||
|
||||
(defun fuel-completion--scroll-completions ()
|
||||
(let ((window fuel-completion--completions-window))
|
||||
(with-current-buffer (window-buffer window)
|
||||
(if (pos-visible-in-window-p (point-max) window)
|
||||
(set-window-start window (point-min))
|
||||
(save-selected-window
|
||||
(select-window window)
|
||||
(scroll-up))))))
|
||||
|
||||
|
||||
;;; Completion functionality:
|
||||
|
||||
(defsubst fuel-completion--word-list (prefix)
|
||||
(let ((fuel-log--inhibit-p t))
|
||||
(fuel-completion--words
|
||||
prefix `("syntax" ,(fuel-syntax--current-vocab) ,@(fuel-syntax--usings)))))
|
||||
|
||||
(defun fuel-completion--complete (prefix)
|
||||
(let* ((words (fuel-completion--word-list prefix))
|
||||
(completions (all-completions prefix words))
|
||||
(partial (try-completion prefix words))
|
||||
(partial (if (eq partial t) prefix partial)))
|
||||
(cons completions partial)))
|
||||
|
||||
(defun fuel-completion--complete-symbol ()
|
||||
"Complete the symbol at point.
|
||||
Perform completion similar to Emacs' complete-symbol."
|
||||
(interactive)
|
||||
(let* ((end (point))
|
||||
(beg (fuel-syntax--symbol-start))
|
||||
(prefix (buffer-substring-no-properties beg end))
|
||||
(result (fuel-completion--complete prefix))
|
||||
(completions (car result))
|
||||
(partial (cdr result)))
|
||||
(cond ((null completions)
|
||||
(fuel--respecting-message "Can't find completion for %S" prefix)
|
||||
(fuel-completion--restore-window-configuration))
|
||||
(t (insert-and-inherit (substring partial (length prefix)))
|
||||
(cond ((= (length completions) 1)
|
||||
(fuel--respecting-message "Sole completion")
|
||||
(fuel-completion--restore-window-configuration))
|
||||
(t (fuel--respecting-message "Complete but not unique")
|
||||
(fuel-completion--display-or-scroll completions
|
||||
partial)))))))
|
||||
|
||||
|
||||
(provide 'fuel-completion)
|
||||
;;; fuel-completion.el ends here
|
||||
|
|
@ -74,10 +74,11 @@
|
|||
|
||||
(defsubst fuel-con--make-connection (buffer)
|
||||
(list :fuel-connection
|
||||
(list :requests)
|
||||
(list :current)
|
||||
(cons :requests (list))
|
||||
(cons :current nil)
|
||||
(cons :completed (make-hash-table :weakness 'value))
|
||||
(cons :buffer buffer)))
|
||||
(cons :buffer buffer)
|
||||
(cons :timer nil)))
|
||||
|
||||
(defsubst fuel-con--connection-p (c)
|
||||
(and (listp c) (eq (car c) :fuel-connection)))
|
||||
|
|
@ -110,6 +111,15 @@
|
|||
(fuel-con--connection-pop-request c)
|
||||
(cdr current))))
|
||||
|
||||
(defun fuel-con--connection-start-timer (c)
|
||||
(let ((cell (assoc :timer c)))
|
||||
(when (cdr cell) (cancel-timer (cdr cell)))
|
||||
(setcdr cell (run-at-time t 0.5 'fuel-con--process-next c))))
|
||||
|
||||
(defun fuel-con--connection-cancel-timer (c)
|
||||
(let ((cell (assoc :timer c)))
|
||||
(when (cdr cell) (cancel-timer (cdr cell)))))
|
||||
|
||||
|
||||
;;; Connection setup:
|
||||
|
||||
|
|
@ -117,7 +127,9 @@
|
|||
(set-buffer buffer)
|
||||
(let ((conn (fuel-con--make-connection buffer)))
|
||||
(fuel-con--setup-comint)
|
||||
(setq fuel-con--connection conn)))
|
||||
(prog1
|
||||
(setq fuel-con--connection conn)
|
||||
(fuel-con--connection-start-timer conn))))
|
||||
|
||||
(defun fuel-con--setup-comint ()
|
||||
(add-hook 'comint-redirect-filter-functions
|
||||
|
|
@ -133,13 +145,13 @@
|
|||
(let* ((buffer (fuel-con--connection-buffer con))
|
||||
(req (fuel-con--connection-pop-request con))
|
||||
(str (and req (fuel-con--request-string req))))
|
||||
(when (and buffer req str)
|
||||
(set-buffer buffer)
|
||||
(when fuel-log--verbose-p
|
||||
(with-current-buffer (fuel-log--buffer)
|
||||
(let ((inhibit-read-only t))
|
||||
(fuel-log--info "<%s>: %s" (fuel-con--request-id req) str))))
|
||||
(comint-redirect-send-command str (fuel-log--buffer) nil t)))))
|
||||
(if (not (buffer-live-p buffer))
|
||||
(fuel-con--connection-cancel-timer con)
|
||||
(when (and buffer req str)
|
||||
(set-buffer buffer)
|
||||
(fuel-log--info "<%s>: %s" (fuel-con--request-id req) str)
|
||||
(comint-redirect-send-command (format "%s" str)
|
||||
(fuel-log--buffer) nil t))))))
|
||||
|
||||
(defun fuel-con--process-completed-request (req)
|
||||
(let ((str (fuel-con--request-output req))
|
||||
|
|
@ -155,7 +167,7 @@
|
|||
(funcall cont str)
|
||||
(fuel-log--info "<%s>: processed\n\t%s" id str))
|
||||
(error (fuel-log--error "<%s>: continuation failed %S \n\t%s"
|
||||
id rstr cerr))))))
|
||||
id rstr cerr))))))
|
||||
|
||||
(defun fuel-con--comint-redirect-filter (str)
|
||||
(if (not fuel-con--connection)
|
||||
|
|
@ -164,7 +176,7 @@
|
|||
(if (not req) (fuel-log--error "No current request (%s)" str)
|
||||
(fuel-con--request-output req str)
|
||||
(fuel-log--info "<%s>: in progress" (fuel-con--request-id req)))))
|
||||
".")
|
||||
(fuel--shorten-str str 70))
|
||||
|
||||
(defun fuel-con--comint-redirect-hook ()
|
||||
(if (not fuel-con--connection)
|
||||
|
|
@ -193,15 +205,18 @@
|
|||
(defun fuel-con--send-string/wait (buffer/proc str cont &optional timeout sbuf)
|
||||
(save-current-buffer
|
||||
(let* ((con (fuel-con--get-connection buffer/proc))
|
||||
(req (fuel-con--send-string buffer/proc str cont sbuf))
|
||||
(id (and req (fuel-con--request-id req)))
|
||||
(time (or timeout fuel-connection-timeout))
|
||||
(step 2))
|
||||
(req (fuel-con--send-string buffer/proc str cont sbuf))
|
||||
(id (and req (fuel-con--request-id req)))
|
||||
(time (or timeout fuel-connection-timeout))
|
||||
(step 100)
|
||||
(waitsecs (/ step 1000.0)))
|
||||
(when id
|
||||
(while (and (> time 0)
|
||||
(not (fuel-con--connection-completed-p con id)))
|
||||
(sleep-for 0 step)
|
||||
(setq time (- time step)))
|
||||
(condition-case nil
|
||||
(while (and (> time 0)
|
||||
(not (fuel-con--connection-completed-p con id)))
|
||||
(accept-process-output nil waitsecs)
|
||||
(setq time (- time step)))
|
||||
(error (setq time 1)))
|
||||
(or (> time 0)
|
||||
(fuel-con--request-deactivate req)
|
||||
nil)))))
|
||||
|
|
|
|||
|
|
@ -119,6 +119,7 @@
|
|||
(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))
|
||||
(not err))))
|
||||
|
||||
|
|
@ -130,7 +131,7 @@
|
|||
(trail (and last (substring-no-properties last (/ llen 2))))
|
||||
(err (fuel-eval--retort-error ret))
|
||||
(p (point)))
|
||||
(save-excursion (insert current))
|
||||
(when current (save-excursion (insert current)))
|
||||
(when (and (> clen llen) (> llen 0) (search-forward trail nil t))
|
||||
(delete-region p (point)))
|
||||
(goto-char (point-max))
|
||||
|
|
|
|||
|
|
@ -17,6 +17,8 @@
|
|||
(require 'fuel-syntax)
|
||||
(require 'fuel-connection)
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
|
||||
|
||||
;;; Simple sexp-based representation of factor code
|
||||
|
||||
|
|
@ -39,7 +41,7 @@
|
|||
(:rs 'fuel-eval-restartable)
|
||||
(:nrs 'fuel-eval-non-restartable)
|
||||
(:in (fuel-syntax--current-vocab))
|
||||
(:usings `(:array ,@(fuel-syntax--usings-update)))
|
||||
(:usings `(:array ,@(fuel-syntax--usings)))
|
||||
(:get 'fuel-eval-set-result)
|
||||
(t `(:factor ,(symbol-name sexp))))))
|
||||
((symbolp sexp) (symbol-name sexp))))
|
||||
|
|
|
|||
|
|
@ -73,7 +73,7 @@
|
|||
|
||||
(defun fuel-help--word-synopsis (&optional word)
|
||||
(let ((word (or word (fuel-syntax-symbol-at-point)))
|
||||
(fuel-eval--log t))
|
||||
(fuel-log--inhibit-p t))
|
||||
(when word
|
||||
(let* ((cmd `(:fuel* (((:quote ,word) synopsis :get)) t))
|
||||
(ret (fuel-eval--send/wait cmd 20)))
|
||||
|
|
@ -157,7 +157,7 @@ displayed in the minibuffer."
|
|||
(defun fuel-help--show-help-cont (def ret)
|
||||
(let ((out (fuel-eval--retort-output ret)))
|
||||
(if (or (fuel-eval--retort-error ret) (empty-string-p out))
|
||||
(message "No help for '%s'" def)
|
||||
(message "No help for '%s'" ret)
|
||||
(fuel-help--insert-contents def out))))
|
||||
|
||||
(defun fuel-help--insert-contents (def str &optional nopush)
|
||||
|
|
@ -225,6 +225,8 @@ buffer."
|
|||
(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)
|
||||
(define-key map "n" 'fuel-help-next)
|
||||
(define-key map (kbd "SPC") 'scroll-up)
|
||||
(define-key map (kbd "S-SPC") 'scroll-down)
|
||||
map))
|
||||
|
|
|
|||
|
|
@ -49,9 +49,16 @@ buffer."
|
|||
|
||||
;;; Fuel listener buffer/process:
|
||||
|
||||
(defvar fuel-listener-buffer nil
|
||||
(defvar fuel-listener--buffer nil
|
||||
"The buffer in which the Factor listener is running.")
|
||||
|
||||
(defun fuel-listener--buffer ()
|
||||
(if (buffer-live-p fuel-listener--buffer)
|
||||
fuel-listener--buffer
|
||||
(with-current-buffer (get-buffer-create "*fuel listener*")
|
||||
(fuel-listener-mode)
|
||||
(setq fuel-listener--buffer (current-buffer)))))
|
||||
|
||||
(defun fuel-listener--start-process ()
|
||||
(let ((factor (expand-file-name fuel-listener-factor-binary))
|
||||
(image (expand-file-name fuel-listener-factor-image)))
|
||||
|
|
@ -59,19 +66,18 @@ buffer."
|
|||
(error "Could not run factor: %s is not executable" factor))
|
||||
(unless (file-readable-p image)
|
||||
(error "Could not run factor: image file %s not readable" image))
|
||||
(setq fuel-listener-buffer (get-buffer-create "*fuel listener*"))
|
||||
(with-current-buffer fuel-listener-buffer
|
||||
(fuel-listener-mode)
|
||||
(message "Starting FUEL listener ...")
|
||||
(comint-exec fuel-listener-buffer "factor"
|
||||
factor nil `("-run=fuel" ,(format "-i=%s" image)))
|
||||
(fuel-listener--wait-for-prompt 20)
|
||||
(fuel-eval--send/wait "USE: fuel")
|
||||
(message "FUEL listener up and running!"))))
|
||||
(message "Starting FUEL listener ...")
|
||||
(comint-exec (fuel-listener--buffer) "factor"
|
||||
factor nil `("-run=fuel" ,(format "-i=%s" image)))
|
||||
(pop-to-buffer (fuel-listener--buffer))
|
||||
(goto-char (point-max))
|
||||
(comint-send-string nil "USE: fuel \"\\nFUEL loaded\\n\" write\n")
|
||||
(fuel-listener--wait-for-prompt 30)
|
||||
(message "FUEL listener up and running!")))
|
||||
|
||||
(defun fuel-listener--process (&optional start)
|
||||
(or (and (buffer-live-p fuel-listener-buffer)
|
||||
(get-buffer-process fuel-listener-buffer))
|
||||
(or (and (buffer-live-p (fuel-listener--buffer))
|
||||
(get-buffer-process (fuel-listener--buffer)))
|
||||
(if (not start)
|
||||
(error "No running factor listener (try M-x run-factor)")
|
||||
(fuel-listener--start-process)
|
||||
|
|
@ -83,18 +89,17 @@ buffer."
|
|||
;;; Prompt chasing
|
||||
|
||||
(defun fuel-listener--wait-for-prompt (&optional timeout)
|
||||
(let ((proc (get-buffer-process fuel-listener-buffer)))
|
||||
(with-current-buffer fuel-listener-buffer
|
||||
(goto-char (or comint-last-input-end (point-min)))
|
||||
(let ((seen (re-search-forward comint-prompt-regexp nil t)))
|
||||
(while (and (not seen)
|
||||
(accept-process-output proc (or timeout 10) nil t))
|
||||
(sleep-for 0 1)
|
||||
(goto-char comint-last-input-end)
|
||||
(setq seen (re-search-forward comint-prompt-regexp nil t)))
|
||||
(pop-to-buffer fuel-listener-buffer)
|
||||
(goto-char (point-max))
|
||||
(unless seen (error "No prompt found!"))))))
|
||||
(let ((proc (get-buffer-process (fuel-listener--buffer)))
|
||||
(seen))
|
||||
(with-current-buffer (fuel-listener--buffer)
|
||||
(goto-char (or comint-last-input-end (point-max)))
|
||||
(while (and (not seen)
|
||||
(accept-process-output proc (or timeout 10) nil t))
|
||||
(sleep-for 0 1)
|
||||
(goto-char comint-last-input-end)
|
||||
(setq seen (re-search-forward comint-prompt-regexp nil t)))
|
||||
(goto-char (point-max))
|
||||
(unless seen (error "No prompt found!")))))
|
||||
|
||||
|
||||
;;; Interface: starting fuel listener
|
||||
|
|
@ -114,13 +119,12 @@ buffer."
|
|||
|
||||
;;; Fuel listener mode:
|
||||
|
||||
(defconst fuel-listener--prompt-regex "( [^)]* ) ")
|
||||
(defconst fuel-listener--prompt-regex ".* ) ")
|
||||
|
||||
(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-listener--prompt-regex)
|
||||
(set (make-local-variable 'comint-prompt-regexp) fuel-listener--prompt-regex)
|
||||
(set (make-local-variable 'comint-prompt-read-only) t)
|
||||
(setq fuel-listener--compilation-begin nil))
|
||||
|
||||
|
|
|
|||
|
|
@ -31,6 +31,9 @@
|
|||
(defvar fuel-log--verbose-p t
|
||||
"Log level for Factor messages")
|
||||
|
||||
(defvar fuel-log--inhibit-p nil
|
||||
"Set this to t to inhibit all log messages")
|
||||
|
||||
(define-derived-mode factor-messages-mode fundamental-mode "FUEL Messages"
|
||||
"Simple mode to log interactions with the factor listener"
|
||||
(kill-all-local-variables)
|
||||
|
|
@ -52,11 +55,12 @@
|
|||
(current-buffer))))
|
||||
|
||||
(defun fuel-log--msg (type &rest args)
|
||||
(with-current-buffer (fuel-log--buffer)
|
||||
(let ((inhibit-read-only t))
|
||||
(insert
|
||||
(fuel--shorten-str (format "\n%s: %s\n" type (apply 'format args))
|
||||
fuel-log--max-message-size)))))
|
||||
(unless fuel-log--inhibit-p
|
||||
(with-current-buffer (fuel-log--buffer)
|
||||
(let ((inhibit-read-only t))
|
||||
(insert
|
||||
(fuel--shorten-str (format "\n%s: %s\n" type (apply 'format args))
|
||||
fuel-log--max-message-size))))))
|
||||
|
||||
(defsubst fuel-log--warn (&rest args)
|
||||
(apply 'fuel-log--msg 'WARNING args))
|
||||
|
|
@ -65,7 +69,8 @@
|
|||
(apply 'fuel-log--msg 'ERROR args))
|
||||
|
||||
(defsubst fuel-log--info (&rest args)
|
||||
(if fuel-log--verbose-p (apply 'fuel-log--msg 'INFO args) ""))
|
||||
(when fuel-log--verbose-p
|
||||
(apply 'fuel-log--msg 'INFO args) ""))
|
||||
|
||||
|
||||
(provide 'fuel-log)
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@
|
|||
(require 'fuel-debug)
|
||||
(require 'fuel-help)
|
||||
(require 'fuel-eval)
|
||||
(require 'fuel-completion)
|
||||
(require 'fuel-listener)
|
||||
|
||||
|
||||
|
|
@ -67,13 +68,12 @@ buffer in case of errors."
|
|||
(interactive "r\nP")
|
||||
(let* ((lines (split-string (buffer-substring-no-properties begin end)
|
||||
"[\f\n\r\v]+" t))
|
||||
(cmd `(:fuel (,(mapcar (lambda (l) `(:factor ,l)) lines)))))
|
||||
(cmd `(:fuel (,(mapcar (lambda (l) `(:factor ,l)) lines))))
|
||||
(cv (fuel-syntax--current-vocab)))
|
||||
(fuel-debug--display-retort
|
||||
(fuel-eval--send/wait cmd 10000)
|
||||
(format "%s%s"
|
||||
(if fuel-syntax--current-vocab
|
||||
(format "IN: %s " fuel-syntax--current-vocab)
|
||||
"")
|
||||
(if cv (format "IN: %s " cv) "")
|
||||
(fuel--shorten-region begin end 70))
|
||||
arg
|
||||
(buffer-file-name))))
|
||||
|
|
@ -125,23 +125,24 @@ With prefix, asks for the word to edit."
|
|||
(let ((cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
|
||||
(condition-case nil
|
||||
(fuel--try-edit (fuel-eval--send/wait cmd))
|
||||
(error (fuel-edit-vocabulary word))))))
|
||||
(error (fuel-edit-vocabulary nil word))))))
|
||||
|
||||
(defvar fuel--vocabs-prompt-history nil)
|
||||
|
||||
(defun fuel--read-vocabulary-name ()
|
||||
(let* ((cmd '(:fuel* (fuel-get-vocabs) "fuel" t))
|
||||
(vocabs (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
|
||||
(defun fuel--read-vocabulary-name (refresh)
|
||||
(let* ((vocabs (fuel-completion--vocabs refresh))
|
||||
(prompt "Vocabulary name: "))
|
||||
(if vocabs
|
||||
(completing-read prompt vocabs nil t nil fuel--vocabs-prompt-history)
|
||||
(read-string prompt nil fuel--vocabs-prompt-history))))
|
||||
|
||||
(defun fuel-edit-vocabulary (vocab)
|
||||
(defun fuel-edit-vocabulary (&optional refresh vocab)
|
||||
"Visits vocabulary file in Emacs.
|
||||
When called interactively, asks for vocabulary with completion."
|
||||
(interactive (list (fuel--read-vocabulary-name)))
|
||||
(let* ((cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t)))
|
||||
When called interactively, asks for vocabulary with completion.
|
||||
With prefix argument, refreshes cached vocabulary list."
|
||||
(interactive "P")
|
||||
(let* ((vocab (or vocab (fuel--read-vocabulary-name refresh)))
|
||||
(cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t)))
|
||||
(fuel--try-edit (fuel-eval--send/wait cmd))))
|
||||
|
||||
|
||||
|
|
@ -183,22 +184,19 @@ interacting with a factor listener is at your disposal.
|
|||
(define-key fuel-mode-map (vector '(control ?c) `(control ,p) `(control ,k)) c))
|
||||
|
||||
(fuel-mode--key-1 ?z 'run-factor)
|
||||
|
||||
(fuel-mode--key-1 ?k 'fuel-run-file)
|
||||
(fuel-mode--key ?e ?k 'fuel-run-file)
|
||||
(fuel-mode--key-1 ?r 'fuel-eval-region)
|
||||
|
||||
(define-key fuel-mode-map "\C-\M-x" 'fuel-eval-definition)
|
||||
(fuel-mode--key ?e ?x 'fuel-eval-definition)
|
||||
|
||||
(fuel-mode--key-1 ?r 'fuel-eval-region)
|
||||
(fuel-mode--key ?e ?r 'fuel-eval-region)
|
||||
|
||||
(define-key fuel-mode-map "\C-\M-r" 'fuel-eval-extended-region)
|
||||
(fuel-mode--key ?e ?e 'fuel-eval-extended-region)
|
||||
|
||||
(fuel-mode--key ?e ?v 'fuel-edit-vocabulary)
|
||||
|
||||
(define-key fuel-mode-map "\M-." 'fuel-edit-word-at-point)
|
||||
(define-key fuel-mode-map (kbd "M-TAB") 'fuel-completion--complete-symbol)
|
||||
|
||||
(fuel-mode--key ?e ?e 'fuel-eval-extended-region)
|
||||
(fuel-mode--key ?e ?r 'fuel-eval-region)
|
||||
(fuel-mode--key ?e ?v 'fuel-edit-vocabulary)
|
||||
(fuel-mode--key ?e ?w 'fuel-edit-word-at-point)
|
||||
(fuel-mode--key ?e ?x 'fuel-eval-definition)
|
||||
|
||||
(fuel-mode--key ?d ?a 'fuel-autodoc-mode)
|
||||
(fuel-mode--key ?d ?d 'fuel-help)
|
||||
|
|
|
|||
|
|
@ -22,11 +22,17 @@
|
|||
(while (eq (char-before) ?:) (backward-char))
|
||||
(skip-syntax-backward "w_"))
|
||||
|
||||
(defsubst fuel-syntax--symbol-start ()
|
||||
(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)))
|
||||
|
||||
(defsubst fuel-syntax--symbol-end ()
|
||||
(save-excursion (fuel-syntax--end-of-symbol) (point)))
|
||||
|
||||
(put 'factor-symbol 'end-op 'fuel-syntax--end-of-symbol)
|
||||
(put 'factor-symbol 'beginning-op 'fuel-syntax--beginning-of-symbol)
|
||||
|
||||
|
|
@ -34,6 +40,7 @@
|
|||
(let ((s (substring-no-properties (thing-at-point 'factor-symbol))))
|
||||
(and (> (length s) 0) s)))
|
||||
|
||||
|
||||
|
||||
;;; Regexps galore:
|
||||
|
||||
|
|
@ -43,7 +50,7 @@
|
|||
"DEFER:" "ERROR:" "EXCLUDE:" "FORGET:"
|
||||
"GENERIC#" "GENERIC:" "HEX:" "HOOK:" "H{"
|
||||
"IN:" "INSTANCE:" "INTERSECTION:"
|
||||
"M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "METHOD:" "MIXIN:"
|
||||
"M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "MEMO:" "METHOD:" "MIXIN:"
|
||||
"OCT:" "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"
|
||||
"REQUIRE:" "REQUIRES:" "SINGLETON:" "SLOT:" "SYMBOL:" "SYMBOLS:"
|
||||
"TUPLE:" "T{" "t\\??" "TYPEDEF:"
|
||||
|
|
@ -91,7 +98,7 @@
|
|||
(defconst fuel-syntax--sub-vocab-regex "^<\\([^ \n]+\\) *$")
|
||||
|
||||
(defconst fuel-syntax--definition-starters-regex
|
||||
(regexp-opt '("VARS" "TUPLE" "MACRO" "MACRO:" "M" ":" "")))
|
||||
(regexp-opt '("VARS" "TUPLE" "MACRO" "MACRO:" "M" "MEMO" "METHOD" ":" "")))
|
||||
|
||||
(defconst fuel-syntax--definition-start-regex
|
||||
(format "^\\(%s:\\) " fuel-syntax--definition-starters-regex))
|
||||
|
|
@ -234,18 +241,13 @@
|
|||
|
||||
;;; USING/IN:
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-syntax--current-vocab nil))
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-syntax--usings nil))
|
||||
|
||||
(defun fuel-syntax--current-vocab ()
|
||||
(let ((ip
|
||||
(save-excursion
|
||||
(when (re-search-backward fuel-syntax--current-vocab-regex nil t)
|
||||
(setq fuel-syntax--current-vocab (match-string-no-properties 1))
|
||||
(point)))))
|
||||
(let* ((vocab)
|
||||
(ip
|
||||
(save-excursion
|
||||
(when (re-search-backward fuel-syntax--current-vocab-regex nil t)
|
||||
(setq vocab (match-string-no-properties 1))
|
||||
(point)))))
|
||||
(when ip
|
||||
(let ((pp (save-excursion
|
||||
(when (re-search-backward fuel-syntax--sub-vocab-regex ip t)
|
||||
|
|
@ -253,29 +255,19 @@
|
|||
(when (and pp (> pp ip))
|
||||
(let ((sub (match-string-no-properties 1)))
|
||||
(unless (save-excursion (search-backward (format "%s>" sub) pp t))
|
||||
(setq fuel-syntax--current-vocab
|
||||
(format "%s.%s" fuel-syntax--current-vocab (downcase sub)))))))))
|
||||
fuel-syntax--current-vocab)
|
||||
(setq vocab (format "%s.%s" vocab (downcase sub))))))))
|
||||
vocab))
|
||||
|
||||
(defun fuel-syntax--usings-update ()
|
||||
(defun fuel-syntax--usings ()
|
||||
(save-excursion
|
||||
(let ((in (fuel-syntax--current-vocab)))
|
||||
(setq fuel-syntax--usings (and in (list in))))
|
||||
(while (re-search-backward fuel-syntax--using-lines-regex nil t)
|
||||
(dolist (u (split-string (match-string-no-properties 1) nil t))
|
||||
(push u fuel-syntax--usings)))
|
||||
fuel-syntax--usings))
|
||||
|
||||
(defsubst fuel-syntax--usings-update-hook ()
|
||||
(fuel-syntax--usings-update)
|
||||
nil)
|
||||
|
||||
(defun fuel-syntax--enable-usings ()
|
||||
(add-hook 'before-save-hook 'fuel-syntax--usings-update-hook nil t)
|
||||
(fuel-syntax--usings-update))
|
||||
|
||||
(defsubst fuel-syntax--usings ()
|
||||
(or fuel-syntax--usings (fuel-syntax--usings-update)))
|
||||
(let ((usings)
|
||||
(in (fuel-syntax--current-vocab)))
|
||||
(when in (setq usings (list in)))
|
||||
(goto-char (point-max))
|
||||
(while (re-search-backward fuel-syntax--using-lines-regex nil t)
|
||||
(dolist (u (split-string (match-string-no-properties 1) nil t))
|
||||
(push u usings)))
|
||||
usings)))
|
||||
|
||||
|
||||
(provide 'fuel-syntax)
|
||||
|
|
|
|||
Loading…
Reference in New Issue