combinators continuations debugger definitions eval help
io io.files io.streams.string kernel lexer listener listener.private
make math namespaces parser prettyprint prettyprint.config
-quotations sequences strings source-files vectors vocabs.loader ;
+quotations sequences strings source-files vectors vocabs vocabs.loader ;
IN: fuel
: 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-get-vocab-location ( vocab -- )
+ vocab-source-path [
+ (normalize-path) 1 2array fuel-eval-set-result
+ ] when* ;
+
+: fuel-get-vocabs ( -- )
+ vocabs fuel-eval-set-result ; inline
: fuel-run-file ( path -- ) run-file ; inline
- C-co : cycle between code, tests and docs factor files
- M-. : edit word at point in Emacs (also in listener)
+ - C-cC-ev : edit vocabulary
- C-cr, C-cC-er : eval region
- C-M-r, C-cC-ee : eval region, extending it to definition boundaries
(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)))
+ (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) (= ln (line-number-at-pos cl)))
- (fuel-syntax--indentation-at op)
- (fuel-syntax--increased-indentation (fuel-syntax--indentation-at op))))))))
+ (if (and (> cl 0)
+ (= (- cl (point)) (current-indentation))
+ (= ln (line-number-at-pos cl)))
+ iop
+ (fuel-syntax--increased-indentation iop)))))))
(defun factor-mode--indent-definition ()
(save-excursion
(cons :id (random))
(cons :string str)
(cons :continuation cont)
- (cons :buffer (or sender-buffer (current-buffer)))))
+ (cons :buffer (or sender-buffer (current-buffer)))
+ (cons :output "")))
(defsubst fuel-con--request-p (req)
(and (listp req) (eq (car req) :fuel-connection-request)))
(defsubst fuel-con--request-buffer (req)
(cdr (assoc :buffer req)))
+(defun fuel-con--request-output (req &optional suffix)
+ (let ((cell (assoc :output req)))
+ (when suffix (setcdr cell (concat (cdr cell) suffix)))
+ (cdr cell)))
+
(defsubst fuel-con--request-deactivate (req)
(setcdr (assoc :continuation req) nil))
(if (and (cdr current)
(fuel-con--request-deactivated-p (cdr current)))
(fuel-con--connection-pop-request c)
- current)))
+ (cdr current))))
\f
;;; Connection setup:
(defun fuel-con--setup-comint ()
(add-hook 'comint-redirect-filter-functions
- 'fuel-con--comint-redirect-filter t t))
+ 'fuel-con--comint-redirect-filter t t)
+ (add-hook 'comint-redirect-hook
+ 'fuel-con--comint-redirect-hook))
\f
;;; Logging:
(factor-messages-mode)
(current-buffer))))
-(defsubst fuel-con--log-msg (type &rest args)
- (format "\n%s: %s\n" type (apply 'format args)))
+(defun fuel-con--log-msg (type &rest args)
+ (with-current-buffer (fuel-con--log-buffer)
+ (let ((inhibit-read-only t))
+ (insert (format "\n%s: %s\n" type (apply 'format args))))))
(defsubst fuel-con--log-warn (&rest args)
(apply 'fuel-con--log-msg 'WARNING args))
(when fuel-con--log-verbose-p
(with-current-buffer (fuel-con--log-buffer)
(let ((inhibit-read-only t))
- (insert (fuel-con--log-info "<%s>: %s"
- (fuel-con--request-id req) str)))))
+ (fuel-con--log-info "<%s>: %s" (fuel-con--request-id req) str))))
(comint-redirect-send-command str (fuel-con--log-buffer) nil t)))))
+(defun fuel-con--process-completed-request (req)
+ (let ((str (fuel-con--request-output req))
+ (cont (fuel-con--request-continuation req))
+ (id (fuel-con--request-id req))
+ (rstr (fuel-con--request-string req))
+ (buffer (fuel-con--request-buffer req)))
+ (if (not cont)
+ (fuel-con--log-warn "<%s> Droping result for request %S (%s)"
+ id rstr str)
+ (condition-case cerr
+ (with-current-buffer (or buffer (current-buffer))
+ (funcall cont str)
+ (fuel-con--log-info "<%s>: processed\n\t%s" id str))
+ (error (fuel-con--log-error "<%s>: continuation failed %S \n\t%s"
+ id rstr cerr))))))
+
(defun fuel-con--comint-redirect-filter (str)
(if (not fuel-con--connection)
(fuel-con--log-error "No connection in buffer (%s)" str)
(let ((req (fuel-con--connection-current-request fuel-con--connection)))
(if (not req) (fuel-con--log-error "No current request (%s)" 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)
- (fuel-con--log-warn "<%s> Droping result for request %S (%s)"
- id rstr str)
- (condition-case cerr
- (with-current-buffer (or buffer (current-buffer))
- (funcall cont str)
- (fuel-con--log-info "<%s>: processed\n\t%s" id str))
- (error (fuel-con--log-error "<%s>: continuation failed %S \n\t%s"
- id rstr cerr))))
- (fuel-con--connection-clean-current-request fuel-con--connection)))))))
+ (fuel-con--request-output req str)
+ (fuel-con--log-info "<%s>: in progress" (fuel-con--request-id req)))))
+ ".\n")
+
+(defun fuel-con--comint-redirect-hook ()
+ (if (not fuel-con--connection)
+ (fuel-con--log-error "No connection in buffer")
+ (let ((req (fuel-con--connection-current-request fuel-con--connection)))
+ (if (not req) (fuel-con--log-error "No current request (%s)" str)
+ (fuel-con--process-completed-request req)
+ (fuel-con--connection-clean-current-request fuel-con--connection)))))
\f
;;; Message sending interface:
(unless (< begin end) (error "No evaluable definition around point"))
(fuel-eval-region begin end arg))))
+(defun fuel--try-edit (ret)
+ (let* ((err (fuel-eval--retort-error ret))
+ (loc (fuel-eval--retort-result ret)))
+ (when (or err (not loc) (not (listp loc)) (not (stringp (car loc))))
+ (error "Couldn't find edit location for '%s'" word))
+ (unless (file-readable-p (car loc))
+ (error "Couldn't open '%s' for read" (car loc)))
+ (find-file-other-window (car loc))
+ (goto-line (if (numberp (cadr loc)) (cadr loc) 1))))
+
(defun fuel-edit-word-at-point (&optional arg)
"Opens a new window visiting the definition of the word at point.
With prefix, asks for the word to edit."
(if word (format " (%s)" word) ""))
word)
word)))
- (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))))
- (error "Couldn't find edit location for '%s'" word))
- (unless (file-readable-p (car loc))
- (error "Couldn't open '%s' for read" (car loc)))
- (find-file-other-window (car loc))
- (goto-line (if (numberp (cadr loc)) (cadr loc) 1)))))
+ (let ((str (fuel-eval--cmd/string
+ (format "\\ %s fuel-get-edit-location" word))))
+ (condition-case nil
+ (fuel--try-edit (fuel-eval--send/wait str))
+ (error (fuel-edit-vocabulary word))))))
+
+(defvar fuel--vocabs-prompt-history nil)
+
+(defun fuel--read-vocabulary-name ()
+ (let* ((str (fuel-eval--cmd/string "fuel-get-vocabs" t "fuel" t))
+ (vocabs (fuel-eval--retort-result (fuel-eval--send/wait str)))
+ (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)
+ "Visits vocabulary file in Emacs.
+When called interactively, asks for vocabulary with completion."
+ (interactive (list (fuel--read-vocabulary-name)))
+ (let* ((str (fuel-eval--cmd/string
+ (format "%S fuel-get-vocab-location" vocab) t "fuel" t)))
+ (fuel--try-edit (fuel-eval--send/wait str))))
\f
;;; Minor mode definition:
(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)
(fuel-mode--key ?d ?a 'fuel-autodoc-mode)
projects / factor.git / commitdiff