FUEL: Asynchronous comms with Factor implemented. Help mode improvements.
Jose A. Ortega Ruiz
parent
210c661d4d
commit
d3c279469c
|
|
@ -151,7 +151,8 @@ M: source-file fuel-pprint path>> fuel-pprint ;
|
|||
: fuel-end-eval ( -- ) [ ] (fuel-end-eval) ; inline
|
||||
|
||||
: fuel-get-edit-location ( defspec -- )
|
||||
where [ first2 [ (normalize-path) ] dip 2array fuel-eval-set-result ] when* ;
|
||||
where [ first2 [ (normalize-path) ] dip 2array fuel-eval-set-result ]
|
||||
when* ;
|
||||
|
||||
: fuel-run-file ( path -- ) run-file ; inline
|
||||
|
||||
|
|
|
|||
|
|
@ -50,7 +50,7 @@ Quick key reference
|
|||
(Chords ending in a single letter <x> accept also C-<x> (e.g. C-cC-z is
|
||||
the same as C-cz)).
|
||||
|
||||
* In factor files:
|
||||
* In factor source files:
|
||||
|
||||
- C-cz : switch to listener
|
||||
- C-co : cycle between code, tests and docs factor files
|
||||
|
|
@ -70,6 +70,13 @@ the same as C-cz)).
|
|||
|
||||
- g : go to error
|
||||
- <digit> : invoke nth restart
|
||||
- w/e/l : invoke :warnings, :errors, :linkage
|
||||
- q : bury buffer
|
||||
|
||||
* In the Help browser:
|
||||
|
||||
- RET : help for word at point
|
||||
- f/b : next/previous page
|
||||
- SPC/S-SPC : scroll up/down
|
||||
- q: bury buffer
|
||||
|
||||
|
|
|
|||
|
|
@ -59,5 +59,7 @@
|
|||
" ")
|
||||
len))
|
||||
|
||||
(defsubst empty-string-p (str) (equal str ""))
|
||||
|
||||
(provide 'fuel-base)
|
||||
;;; fuel-base.el ends here
|
||||
|
|
|
|||
|
|
@ -0,0 +1,186 @@
|
|||
;;; fuel-connection.el -- asynchronous comms with the fuel listener
|
||||
|
||||
;; 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: Thu Dec 11, 2008 03:10
|
||||
|
||||
;;; Comentary:
|
||||
|
||||
;; Handling communications via a comint buffer running a factor
|
||||
;; listener.
|
||||
|
||||
;;; Code:
|
||||
|
||||
|
||||
;;; Default connection:
|
||||
|
||||
(make-variable-buffer-local
|
||||
(defvar fuel-con--connection nil))
|
||||
|
||||
(defun fuel-con--get-connection (buffer/proc)
|
||||
(if (processp buffer/proc)
|
||||
(fuel-con--get-connection (process-buffer buffer/proc))
|
||||
(with-current-buffer buffer/proc
|
||||
(or fuel-con--connection
|
||||
(setq fuel-con--connection
|
||||
(fuel-con--setup-connection buffer/proc))))))
|
||||
|
||||
|
||||
;;; Request and connection datatypes:
|
||||
|
||||
(defun fuel-con--connection-queue-request (c r)
|
||||
(let ((reqs (assoc :requests c)))
|
||||
(setcdr reqs (append (cdr reqs) (list r)))))
|
||||
|
||||
(defun fuel-con--make-request (str cont &optional sender-buffer)
|
||||
(list :fuel-connection-request
|
||||
(cons :id (random))
|
||||
(cons :string str)
|
||||
(cons :continuation cont)
|
||||
(cons :buffer (or sender-buffer (current-buffer)))))
|
||||
|
||||
(defsubst fuel-con--request-p (req)
|
||||
(and (listp req) (eq (car req) :fuel-connection-request)))
|
||||
|
||||
(defsubst fuel-con--request-id (req)
|
||||
(cdr (assoc :id req)))
|
||||
|
||||
(defsubst fuel-con--request-string (req)
|
||||
(cdr (assoc :string req)))
|
||||
|
||||
(defsubst fuel-con--request-continuation (req)
|
||||
(cdr (assoc :continuation req)))
|
||||
|
||||
(defsubst fuel-con--request-buffer (req)
|
||||
(cdr (assoc :buffer req)))
|
||||
|
||||
(defsubst fuel-con--request-deactivate (req)
|
||||
(setcdr (assoc :continuation req) nil))
|
||||
|
||||
(defsubst fuel-con--request-deactivated-p (req)
|
||||
(null (cdr (assoc :continuation req))))
|
||||
|
||||
(defsubst fuel-con--make-connection (buffer)
|
||||
(list :fuel-connection
|
||||
(list :requests)
|
||||
(list :current)
|
||||
(cons :completed (make-hash-table :weakness 'value))
|
||||
(cons :buffer buffer)))
|
||||
|
||||
(defsubst fuel-con--connection-p (c)
|
||||
(and (listp c) (eq (car c) :fuel-connection)))
|
||||
|
||||
(defsubst fuel-con--connection-requests (c)
|
||||
(cdr (assoc :requests c)))
|
||||
|
||||
(defsubst fuel-con--connection-current-request (c)
|
||||
(cdr (assoc :current c)))
|
||||
|
||||
(defun fuel-con--connection-clean-current-request (c)
|
||||
(let* ((cell (assoc :current c))
|
||||
(req (cdr cell)))
|
||||
(when req
|
||||
(puthash (fuel-con--request-id req) req (cdr (assoc :completed c)))
|
||||
(setcdr cell nil))))
|
||||
|
||||
(defsubst fuel-con--connection-completed-p (c id)
|
||||
(gethash id (cdr (assoc :completed c))))
|
||||
|
||||
(defsubst fuel-con--connection-buffer (c)
|
||||
(cdr (assoc :buffer c)))
|
||||
|
||||
(defun fuel-con--connection-pop-request (c)
|
||||
(let ((reqs (assoc :requests c))
|
||||
(current (assoc :current c)))
|
||||
(setcdr current (prog1 (cadr reqs) (setcdr reqs (cddr reqs))))
|
||||
(if (and current (fuel-con--request-deactivated-p current))
|
||||
(fuel-con--connection-pop-request c)
|
||||
current)))
|
||||
|
||||
|
||||
;;; Connection setup:
|
||||
|
||||
(defun fuel-con--setup-connection (buffer)
|
||||
(set-buffer buffer)
|
||||
(let ((conn (fuel-con--make-connection buffer)))
|
||||
(fuel-con--setup-comint)
|
||||
(setq fuel-con--connection conn)))
|
||||
|
||||
(defun fuel-con--setup-comint ()
|
||||
(add-hook 'comint-redirect-filter-functions
|
||||
'fuel-con--comint-redirect-filter t t))
|
||||
|
||||
|
||||
;;; Requests handling:
|
||||
|
||||
(defun fuel-con--process-next (con)
|
||||
(when (not (fuel-con--connection-current-request con))
|
||||
(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)
|
||||
(comint-redirect-send-command str
|
||||
(get-buffer-create "*factor messages*")
|
||||
nil
|
||||
t)))))
|
||||
|
||||
(defun fuel-con--comint-redirect-filter (str)
|
||||
(if (not fuel-con--connection)
|
||||
(format "\nERROR: No connection in buffer (%s)\n" str)
|
||||
(let ((req (fuel-con--connection-current-request fuel-con--connection)))
|
||||
(if (not req) (format "\nERROR: No current request (%s)\n" str)
|
||||
(let ((cont (fuel-con--request-continuation req))
|
||||
(id (fuel-con--request-id req))
|
||||
(rstr (fuel-con--request-string req))
|
||||
(buffer (fuel-con--request-buffer req)))
|
||||
(prog1
|
||||
(if (not cont)
|
||||
(format "\nWARNING: Droping result for request %s:%S (%s)\n"
|
||||
id rstr str)
|
||||
(condition-case cerr
|
||||
(with-current-buffer (or buffer (current-buffer))
|
||||
(funcall cont str)
|
||||
(format "\nINFO: %s:%S processed\nINFO: %s\n" id rstr str))
|
||||
(error (format "\nERROR: continuation failed %s:%S \nERROR: %s\n"
|
||||
id rstr cerr))))
|
||||
(fuel-con--connection-clean-current-request fuel-con--connection)))))))
|
||||
|
||||
|
||||
;;; Message sending interface:
|
||||
|
||||
(defun fuel-con--send-string (buffer/proc str cont &optional sender-buffer)
|
||||
(save-current-buffer
|
||||
(let ((con (fuel-con--get-connection buffer/proc)))
|
||||
(unless con
|
||||
(error "FUEL: couldn't find connection"))
|
||||
(let ((req (fuel-con--make-request str cont sender-buffer)))
|
||||
(fuel-con--connection-queue-request con req)
|
||||
(fuel-con--process-next con)
|
||||
req))))
|
||||
|
||||
(defvar fuel-connection-timeout 30000
|
||||
"Time limit, in msecs, blocking on synchronous evaluation requests")
|
||||
|
||||
(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))
|
||||
(when id
|
||||
(while (and (> time 0)
|
||||
(not (fuel-con--connection-completed-p con id)))
|
||||
(sleep-for 0 step)
|
||||
(setq time (- time step)))
|
||||
(or (> time 0)
|
||||
(fuel-con--request-deactivate req)
|
||||
nil)))))
|
||||
|
||||
|
||||
(provide 'fuel-connection)
|
||||
;;; fuel-connection.el ends here
|
||||
|
|
@ -214,7 +214,7 @@
|
|||
(buffer (if file (find-file-noselect file) (current-buffer))))
|
||||
(with-current-buffer buffer
|
||||
(fuel-debug--display-retort
|
||||
(fuel-eval--eval-string/context (format ":%s" n))
|
||||
(fuel-eval--send/wait (fuel-eval--cmd/string (format ":%s" n)))
|
||||
(format "Restart %s (%s) successful" n (nth (1- n) rs))))))))
|
||||
|
||||
(defun fuel-debug-show--compiler-info (info)
|
||||
|
|
@ -224,7 +224,8 @@
|
|||
(error "%s information not available" info))
|
||||
(message "Retrieving %s info ..." info)
|
||||
(unless (fuel-debug--display-retort
|
||||
(fuel-eval--eval-string info) "" (fuel-debug--buffer-file))
|
||||
(fuel-eval--send/wait (fuel-eval--cmd/string info))
|
||||
"" (fuel-debug--buffer-file))
|
||||
(error "Sorry, no %s info available" info))))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -1,4 +1,4 @@
|
|||
;;; fuel-eval.el --- utilities for communication with fuel-listener
|
||||
;;; fuel-eval.el --- evaluating Factor expressions
|
||||
|
||||
;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
|
||||
;; See http://factorcode.org/license.txt for BSD license.
|
||||
|
|
@ -9,46 +9,16 @@
|
|||
|
||||
;;; Commentary:
|
||||
|
||||
;; Protocols for handling communications via a comint buffer running a
|
||||
;; factor listener.
|
||||
;; Protocols for sending evaluations to the Factor listener.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-base)
|
||||
(require 'fuel-syntax)
|
||||
(require 'fuel-connection)
|
||||
|
||||
|
||||
;;; Syncronous string sending:
|
||||
|
||||
(defvar fuel-eval-log-max-length 16000)
|
||||
|
||||
(defvar fuel-eval--default-proc-function nil)
|
||||
(defsubst fuel-eval--default-proc ()
|
||||
(and fuel-eval--default-proc-function
|
||||
(funcall fuel-eval--default-proc-function)))
|
||||
|
||||
(defvar fuel-eval--proc nil)
|
||||
(defvar fuel-eval--log t)
|
||||
|
||||
(defun fuel-eval--send-string (str)
|
||||
(let ((proc (or fuel-eval--proc (fuel-eval--default-proc))))
|
||||
(when proc
|
||||
(with-current-buffer (get-buffer-create "*factor messages*")
|
||||
(goto-char (point-max))
|
||||
(when (and (> fuel-eval-log-max-length 0)
|
||||
(> (point) fuel-eval-log-max-length))
|
||||
(erase-buffer))
|
||||
(when fuel-eval--log (insert "\n>> " (fuel--shorten-str str 256)))
|
||||
(newline)
|
||||
(let ((beg (point)))
|
||||
(comint-redirect-send-command-to-process str (current-buffer) proc nil t)
|
||||
(with-current-buffer (process-buffer proc)
|
||||
(while (not comint-redirect-completed) (sleep-for 0 1)))
|
||||
(goto-char beg)
|
||||
(current-buffer))))))
|
||||
|
||||
|
||||
;;; Evaluation protocol
|
||||
;;; Retort and retort-error datatypes:
|
||||
|
||||
(defsubst fuel-eval--retort-make (err result &optional output)
|
||||
(list err result output))
|
||||
|
|
@ -60,57 +30,14 @@
|
|||
(defsubst fuel-eval--retort-p (ret) (listp ret))
|
||||
|
||||
(defsubst fuel-eval--make-parse-error-retort (str)
|
||||
(fuel-eval--retort-make 'parse-retort-error nil str))
|
||||
(fuel-eval--retort-make (cons 'fuel-parse-retort-error str) nil))
|
||||
|
||||
(defun fuel-eval--parse-retort (buffer)
|
||||
(defun fuel-eval--parse-retort (str)
|
||||
(save-current-buffer
|
||||
(set-buffer buffer)
|
||||
(condition-case nil
|
||||
(read (current-buffer))
|
||||
(error (fuel-eval--make-parse-error-retort
|
||||
(buffer-substring-no-properties (point) (point-max)))))))
|
||||
|
||||
(defsubst fuel-eval--send/retort (str)
|
||||
(fuel-eval--parse-retort (fuel-eval--send-string str)))
|
||||
|
||||
(defsubst fuel-eval--eval-begin ()
|
||||
(fuel-eval--send/retort "fuel-begin-eval"))
|
||||
|
||||
(defsubst fuel-eval--eval-end ()
|
||||
(fuel-eval--send/retort "fuel-begin-eval"))
|
||||
|
||||
(defsubst fuel-eval--factor-array (strs)
|
||||
(format "V{ %S }" (mapconcat 'identity strs " ")))
|
||||
|
||||
(defsubst fuel-eval--eval-strings (strs &optional no-restart)
|
||||
(let ((str (format "fuel-eval-%s %s fuel-eval"
|
||||
(if no-restart "non-restartable" "restartable")
|
||||
(fuel-eval--factor-array strs))))
|
||||
(fuel-eval--send/retort str)))
|
||||
|
||||
(defsubst fuel-eval--eval-string (str &optional no-restart)
|
||||
(fuel-eval--eval-strings (list str) no-restart))
|
||||
|
||||
(defun fuel-eval--eval-strings/context (strs &optional no-restart)
|
||||
(let ((usings (fuel-syntax--usings-update)))
|
||||
(fuel-eval--send/retort
|
||||
(format "fuel-eval-%s %s %S %s fuel-eval-in-context"
|
||||
(if no-restart "non-restartable" "restartable")
|
||||
(fuel-eval--factor-array strs)
|
||||
(or fuel-syntax--current-vocab "f")
|
||||
(if usings (fuel-eval--factor-array usings) "f")))))
|
||||
|
||||
(defsubst fuel-eval--eval-string/context (str &optional no-restart)
|
||||
(fuel-eval--eval-strings/context (list str) no-restart))
|
||||
|
||||
(defun fuel-eval--eval-region/context (begin end &optional no-restart)
|
||||
(let ((lines (split-string (buffer-substring-no-properties begin end)
|
||||
"[\f\n\r\v]+" t)))
|
||||
(when (> (length lines) 0)
|
||||
(fuel-eval--eval-strings/context lines no-restart))))
|
||||
|
||||
|
||||
;;; Error parsing
|
||||
(let ((ret (car (read-from-string str))))
|
||||
(if (fuel-eval--retort-p ret) ret (error)))
|
||||
(error (fuel-eval--make-parse-error-retort str)))))
|
||||
|
||||
(defsubst fuel-eval--error-name (err) (car err))
|
||||
|
||||
|
|
@ -137,6 +64,69 @@
|
|||
(defsubst fuel-eval--error-line-text (err)
|
||||
(nth 3 (fuel-eval--error-lexer-p err)))
|
||||
|
||||
|
||||
;;; String sending::
|
||||
|
||||
(defvar fuel-eval-log-max-length 16000)
|
||||
|
||||
(defvar fuel-eval--default-proc-function nil)
|
||||
(defsubst fuel-eval--default-proc ()
|
||||
(and fuel-eval--default-proc-function
|
||||
(funcall fuel-eval--default-proc-function)))
|
||||
|
||||
(defvar fuel-eval--proc nil)
|
||||
|
||||
(defvar fuel-eval--log t)
|
||||
|
||||
(defvar fuel-eval--sync-retort nil)
|
||||
|
||||
(defun fuel-eval--send/wait (str &optional timeout buffer)
|
||||
(setq fuel-eval--sync-retort nil)
|
||||
(fuel-con--send-string/wait (or fuel-eval--proc (fuel-eval--default-proc))
|
||||
str
|
||||
'(lambda (s)
|
||||
(setq fuel-eval--sync-retort
|
||||
(fuel-eval--parse-retort s)))
|
||||
timeout
|
||||
buffer)
|
||||
fuel-eval--sync-retort)
|
||||
|
||||
(defun fuel-eval--send (str cont &optional buffer)
|
||||
(fuel-con--send-string (or fuel-eval--proc (fuel-eval--default-proc))
|
||||
str
|
||||
`(lambda (s) (,cont (fuel-eval--parse-retort s)))
|
||||
buffer))
|
||||
|
||||
|
||||
;;; Evaluation protocol
|
||||
|
||||
(defsubst fuel-eval--factor-array (strs)
|
||||
(format "V{ %S }" (mapconcat 'identity strs " ")))
|
||||
|
||||
(defun fuel-eval--cmd/lines (strs &optional no-rs in usings)
|
||||
(unless (and in usings) (fuel-syntax--usings-update))
|
||||
(let* ((in (cond ((not in) (or fuel-syntax--current-vocab "f"))
|
||||
((eq in t) "fuel-scratchpad")
|
||||
(in in)))
|
||||
(usings (cond ((not usings) fuel-syntax--usings)
|
||||
((eq usings t) nil)
|
||||
(usings usings))))
|
||||
(format "fuel-eval-%srestartable %s %S %s fuel-eval-in-context"
|
||||
(if no-rs "non-" "")
|
||||
(fuel-eval--factor-array strs)
|
||||
in
|
||||
(fuel-eval--factor-array usings))))
|
||||
|
||||
(defsubst fuel-eval--cmd/string (str &optional no-rs in usings)
|
||||
(fuel-eval--cmd/lines (list str) no-rs in usings))
|
||||
|
||||
(defun fuel-eval--cmd/region (begin end &optional no-rs in usings)
|
||||
(let ((lines (split-string (buffer-substring-no-properties begin end)
|
||||
"[\f\n\r\v]+" t)))
|
||||
(when (> (length lines) 0)
|
||||
(fuel-eval--cmd/lines lines no-rs in usings))))
|
||||
|
||||
|
||||
|
||||
(provide 'fuel-eval)
|
||||
;;; fuel-eval.el ends here
|
||||
|
|
|
|||
|
|
@ -57,7 +57,7 @@
|
|||
(,fuel-syntax--type-definition-regex 2 'factor-font-lock-type-name)
|
||||
(,fuel-syntax--method-definition-regex (1 'factor-font-lock-type-name)
|
||||
(2 'factor-font-lock-word))
|
||||
(,fuel-syntax--parent-type-regex 1 'factor-font-lock-type)
|
||||
(,fuel-syntax--parent-type-regex 1 'factor-font-lock-type-name)
|
||||
(,fuel-syntax--constructor-regex . 'factor-font-lock-constructor)
|
||||
(,fuel-syntax--setter-regex . 'factor-font-lock-setter-word)
|
||||
(,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol)
|
||||
|
|
|
|||
|
|
@ -45,6 +45,11 @@
|
|||
:type 'hook
|
||||
:group 'fuel-help)
|
||||
|
||||
(defcustom fuel-help-history-cache-size 50
|
||||
"Maximum number of pages to keep in the help browser cache."
|
||||
: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
|
||||
|
|
@ -70,10 +75,10 @@
|
|||
(let ((word (or word (fuel-syntax-symbol-at-point)))
|
||||
(fuel-eval--log t))
|
||||
(when word
|
||||
(let ((ret (fuel-eval--eval-string/context
|
||||
(format "\\ %s synopsis fuel-eval-set-result" word)
|
||||
t)))
|
||||
(when (not (fuel-eval--retort-error ret))
|
||||
(let* ((str (format "\\ %s synopsis fuel-eval-set-result" word))
|
||||
(cmd (fuel-eval--cmd/string str t t))
|
||||
(ret (fuel-eval--send/wait cmd 20)))
|
||||
(when (and ret (not (fuel-eval--retort-error ret)))
|
||||
(if fuel-help-minibuffer-font-lock
|
||||
(fuel-help--font-lock-str (fuel-eval--retort-result ret))
|
||||
(fuel-eval--retort-result ret)))))))
|
||||
|
|
@ -101,92 +106,83 @@ displayed in the minibuffer."
|
|||
(message "Fuel Autodoc %s" (if fuel-autodoc-mode "enabled" "disabled")))
|
||||
|
||||
|
||||
;;;; Factor help mode:
|
||||
;;; Help browser history:
|
||||
|
||||
(defvar fuel-help-mode-map (make-sparse-keymap)
|
||||
"Keymap for Factor help mode.")
|
||||
(defvar fuel-help--history
|
||||
(list nil
|
||||
(make-ring fuel-help-history-cache-size)
|
||||
(make-ring fuel-help-history-cache-size)))
|
||||
|
||||
(define-key fuel-help-mode-map [(return)] 'fuel-help)
|
||||
(defvar fuel-help--history-idx 0)
|
||||
|
||||
(defconst fuel-help--headlines
|
||||
(regexp-opt '("Class description"
|
||||
"Definition"
|
||||
"Examples"
|
||||
"Generic word contract"
|
||||
"Inputs and outputs"
|
||||
"Methods"
|
||||
"Notes"
|
||||
"Parent topics:"
|
||||
"See also"
|
||||
"Syntax"
|
||||
"Vocabulary"
|
||||
"Warning"
|
||||
"Word description")
|
||||
t))
|
||||
(defun fuel-help--history-push (term)
|
||||
(when (car fuel-help--history)
|
||||
(ring-insert (nth 1 fuel-help--history) (car fuel-help--history)))
|
||||
(setcar fuel-help--history term))
|
||||
|
||||
(defconst fuel-help--headlines-regexp (format "^%s" fuel-help--headlines))
|
||||
(defun fuel-help--history-next ()
|
||||
(when (not (ring-empty-p (nth 2 fuel-help--history)))
|
||||
(when (car fuel-help--history)
|
||||
(ring-insert (nth 1 fuel-help--history) (car fuel-help--history)))
|
||||
(setcar fuel-help--history (ring-remove (nth 2 fuel-help--history) 0))))
|
||||
|
||||
(defconst fuel-help--font-lock-keywords
|
||||
`(,@fuel-font-lock--font-lock-keywords
|
||||
(,fuel-help--headlines-regexp . 'fuel-help-font-lock-headlines)))
|
||||
(defun fuel-help--history-previous ()
|
||||
(when (not (ring-empty-p (nth 1 fuel-help--history)))
|
||||
(when (car fuel-help--history)
|
||||
(ring-insert (nth 2 fuel-help--history) (car fuel-help--history)))
|
||||
(setcar fuel-help--history (ring-remove (nth 1 fuel-help--history) 0))))
|
||||
|
||||
(defun fuel-help-mode ()
|
||||
"Major mode for displaying Factor documentation.
|
||||
\\{fuel-help-mode-map}"
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(use-local-map fuel-help-mode-map)
|
||||
(setq mode-name "Factor Help")
|
||||
(setq major-mode 'fuel-help-mode)
|
||||
|
||||
(fuel-font-lock--font-lock-setup fuel-help--font-lock-keywords t)
|
||||
|
||||
(set (make-local-variable 'view-no-disable-on-exit) t)
|
||||
(view-mode)
|
||||
(setq view-exit-action
|
||||
(lambda (buffer)
|
||||
;; Use `with-current-buffer' to make sure that `bury-buffer'
|
||||
;; also removes BUFFER from the selected window.
|
||||
(with-current-buffer buffer
|
||||
(bury-buffer))))
|
||||
|
||||
(setq fuel-autodoc-mode-string "")
|
||||
(fuel-autodoc-mode)
|
||||
(run-mode-hooks 'fuel-help-mode-hook))
|
||||
|
||||
;;; Fuel help buffer and internals:
|
||||
|
||||
(defun fuel-help--help-buffer ()
|
||||
(with-current-buffer (get-buffer-create "*fuel-help*")
|
||||
(fuel-help-mode)
|
||||
(current-buffer)))
|
||||
|
||||
(defvar fuel-help--history nil)
|
||||
(defvar fuel-help--prompt-history nil)
|
||||
|
||||
(defun fuel-help--show-help (&optional see)
|
||||
(let* ((def (fuel-syntax-symbol-at-point))
|
||||
(defun fuel-help--show-help (&optional see word)
|
||||
(let* ((def (or word (fuel-syntax-symbol-at-point)))
|
||||
(prompt (format "See%s help on%s: " (if see " short" "")
|
||||
(if def (format " (%s)" def) "")))
|
||||
(ask (or (not (memq major-mode '(factor-mode fuel-help-mode)))
|
||||
(not def)
|
||||
fuel-help-always-ask))
|
||||
(def (if ask (read-string prompt nil 'fuel-help--history def) def))
|
||||
(cmd (format "\\ %s %s" def (if see "see" "help")))
|
||||
(fuel-eval--log nil)
|
||||
(ret (fuel-eval--eval-string/context cmd t))
|
||||
(out (fuel-eval--retort-output ret)))
|
||||
(def (if ask (read-string prompt nil 'fuel-help--prompt-history def)
|
||||
def))
|
||||
(cmd (format "\\ %s %s" def (if see "see" "help"))))
|
||||
(message "Looking up '%s' ..." def)
|
||||
(fuel-eval--send (fuel-eval--cmd/string cmd t t)
|
||||
`(lambda (r) (fuel-help--show-help-cont ,def r)))))
|
||||
|
||||
(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)
|
||||
(let ((hb (fuel-help--help-buffer))
|
||||
(inhibit-read-only t)
|
||||
(font-lock-verbose nil))
|
||||
(set-buffer hb)
|
||||
(erase-buffer)
|
||||
(insert out)
|
||||
(set-buffer-modified-p nil)
|
||||
(pop-to-buffer hb)
|
||||
(goto-char (point-min))))))
|
||||
(fuel-help--insert-contents def out))))
|
||||
|
||||
(defun fuel-help--insert-contents (def str &optional nopush)
|
||||
(let ((hb (fuel-help--help-buffer))
|
||||
(inhibit-read-only t)
|
||||
(font-lock-verbose nil))
|
||||
(set-buffer hb)
|
||||
(erase-buffer)
|
||||
(insert str)
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward (format "^%s" def) nil t)
|
||||
(beginning-of-line)
|
||||
(kill-region (point-min) (point))
|
||||
(next-line)
|
||||
(open-line 1))
|
||||
(set-buffer-modified-p nil)
|
||||
(unless nopush (fuel-help--history-push (cons def str)))
|
||||
(pop-to-buffer hb)
|
||||
(goto-char (point-min))
|
||||
(message "%s" def)))
|
||||
|
||||
|
||||
;;; Interface: see/help commands
|
||||
;;; Interactive help commands:
|
||||
|
||||
(defun fuel-help-short (&optional arg)
|
||||
"See a help summary of symbol at point.
|
||||
|
|
@ -204,6 +200,79 @@ buffer."
|
|||
(interactive)
|
||||
(fuel-help--show-help))
|
||||
|
||||
(defun fuel-help-next ()
|
||||
"Go to next page in help browser."
|
||||
(interactive)
|
||||
(let ((item (fuel-help--history-next))
|
||||
(fuel-help-always-ask nil))
|
||||
(unless item
|
||||
(error "No next page"))
|
||||
(fuel-help--insert-contents (car item) (cdr item) t)))
|
||||
|
||||
(defun fuel-help-previous ()
|
||||
"Go to next page in help browser."
|
||||
(interactive)
|
||||
(let ((item (fuel-help--history-previous))
|
||||
(fuel-help-always-ask nil))
|
||||
(unless item
|
||||
(error "No previous page"))
|
||||
(fuel-help--insert-contents (car item) (cdr item) t)))
|
||||
|
||||
|
||||
;;;; Factor help mode:
|
||||
|
||||
(defvar fuel-help-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
(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 (kbd "SPC") 'scroll-up)
|
||||
(define-key map (kbd "S-SPC") 'scroll-down)
|
||||
map))
|
||||
|
||||
(defconst fuel-help--headlines
|
||||
(regexp-opt '("Class description"
|
||||
"Definition"
|
||||
"Errors"
|
||||
"Examples"
|
||||
"Generic word contract"
|
||||
"Inputs and outputs"
|
||||
"Methods"
|
||||
"Notes"
|
||||
"Parent topics:"
|
||||
"See also"
|
||||
"Syntax"
|
||||
"Variable description"
|
||||
"Variable value"
|
||||
"Vocabulary"
|
||||
"Warning"
|
||||
"Word description")
|
||||
t))
|
||||
|
||||
(defconst fuel-help--headlines-regexp (format "^%s" fuel-help--headlines))
|
||||
|
||||
(defconst fuel-help--font-lock-keywords
|
||||
`(,@fuel-font-lock--font-lock-keywords
|
||||
(,fuel-help--headlines-regexp . 'fuel-help-font-lock-headlines)))
|
||||
|
||||
(defun fuel-help-mode ()
|
||||
"Major mode for browsing Factor documentation.
|
||||
\\{fuel-help-mode-map}"
|
||||
(interactive)
|
||||
(kill-all-local-variables)
|
||||
(use-local-map fuel-help-mode-map)
|
||||
(setq mode-name "Factor Help")
|
||||
(setq major-mode 'fuel-help-mode)
|
||||
|
||||
(fuel-font-lock--font-lock-setup fuel-help--font-lock-keywords t)
|
||||
|
||||
(setq fuel-autodoc-mode-string "")
|
||||
(fuel-autodoc-mode)
|
||||
|
||||
(run-mode-hooks 'fuel-help-mode-hook)
|
||||
(toggle-read-only 1))
|
||||
|
||||
|
||||
(provide 'fuel-help)
|
||||
;;; fuel-help.el ends here
|
||||
|
|
|
|||
|
|
@ -66,7 +66,7 @@ buffer."
|
|||
(comint-exec fuel-listener-buffer "factor"
|
||||
factor nil `("-run=fuel" ,(format "-i=%s" image)))
|
||||
(fuel-listener--wait-for-prompt 20)
|
||||
(fuel-eval--send-string "USE: fuel")
|
||||
(fuel-eval--send/wait "USE: fuel")
|
||||
(message "FUEL listener up and running!"))))
|
||||
|
||||
(defun fuel-listener--process (&optional start)
|
||||
|
|
@ -83,18 +83,18 @@ buffer."
|
|||
;;; Prompt chasing
|
||||
|
||||
(defun fuel-listener--wait-for-prompt (&optional timeout)
|
||||
(let ((proc (get-buffer-process fuel-listener-buffer))
|
||||
(seen))
|
||||
(with-current-buffer fuel-listener-buffer
|
||||
(while (progn (goto-char comint-last-input-end)
|
||||
(not (or seen
|
||||
(setq seen
|
||||
(re-search-forward comint-prompt-regexp nil t))
|
||||
(not (accept-process-output proc timeout))))))
|
||||
(goto-char (point-max)))
|
||||
(unless seen
|
||||
(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)
|
||||
(error "No prompt found!"))))
|
||||
(goto-char (point-max))
|
||||
(unless seen (error "No prompt found!"))))))
|
||||
|
||||
|
||||
;;; Interface: starting fuel listener
|
||||
|
|
@ -124,6 +124,8 @@ buffer."
|
|||
(set (make-local-variable 'comint-prompt-read-only) t)
|
||||
(setq fuel-listener--compilation-begin nil))
|
||||
|
||||
(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-ch" 'fuel-help)
|
||||
(define-key fuel-listener-mode-map "\M-." 'fuel-edit-word-at-point)
|
||||
(define-key fuel-listener-mode-map "\C-ck" 'fuel-run-file)
|
||||
|
|
|
|||
|
|
@ -45,16 +45,20 @@ With prefix argument, ask for the file to run."
|
|||
(let* ((file (or (and arg (read-file-name "File: " nil (buffer-file-name) t))
|
||||
(buffer-file-name)))
|
||||
(file (expand-file-name file))
|
||||
(buffer (find-file-noselect file))
|
||||
(cmd (format "%S fuel-run-file" file)))
|
||||
(buffer (find-file-noselect file)))
|
||||
(when buffer
|
||||
(with-current-buffer buffer
|
||||
(message "Compiling %s ..." file)
|
||||
(let ((r (fuel-debug--display-retort (fuel-eval--eval-string/context cmd)
|
||||
(format "%s successfully compiled" file)
|
||||
nil
|
||||
file)))
|
||||
(if r (message "Compiling %s ... OK!" file) (message "")))))))
|
||||
(fuel-eval--send (fuel-eval--cmd/string (format "%S fuel-run-file" file))
|
||||
`(lambda (r) (fuel--run-file-cont r ,file)))))))
|
||||
|
||||
(defun fuel--run-file-cont (ret file)
|
||||
(if (fuel-debug--display-retort ret
|
||||
(format "%s successfully compiled" file)
|
||||
nil
|
||||
file)
|
||||
(message "Compiling %s ... OK!" file)
|
||||
(message "")))
|
||||
|
||||
(defun fuel-eval-region (begin end &optional arg)
|
||||
"Sends region to Fuel's listener for evaluation.
|
||||
|
|
@ -62,7 +66,7 @@ Unless called with a prefix, switchs to the compilation results
|
|||
buffer in case of errors."
|
||||
(interactive "r\nP")
|
||||
(fuel-debug--display-retort
|
||||
(fuel-eval--eval-region/context begin end)
|
||||
(fuel-eval--send/wait (fuel-eval--cmd/region begin end) 10000)
|
||||
(format "%s%s"
|
||||
(if fuel-syntax--current-vocab
|
||||
(format "IN: %s " fuel-syntax--current-vocab)
|
||||
|
|
@ -105,8 +109,9 @@ With prefix, asks for the word to edit."
|
|||
(if word (format " (%s)" word) ""))
|
||||
word)
|
||||
word)))
|
||||
(let* ((ret (fuel-eval--eval-string/context
|
||||
(let* ((str (fuel-eval--cmd/string
|
||||
(format "\\ %s fuel-get-edit-location" word)))
|
||||
(ret (fuel-eval--send/wait str))
|
||||
(err (fuel-eval--retort-error ret))
|
||||
(loc (fuel-eval--retort-result ret)))
|
||||
(when (or err (not loc) (not (listp loc)) (not (stringp (car loc))))
|
||||
|
|
|
|||
Loading…
Reference in New Issue