FUEL: Edit vocabulary interactive command and bug fixes.
Jose A. Ortega Ruiz
parent
0ba761eee7
commit
fbbe8d9e5e
|
|
@ -5,7 +5,7 @@ USING: accessors arrays classes classes.tuple compiler.units
|
|||
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
|
||||
|
||||
|
|
@ -151,8 +151,17 @@ 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-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
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
- 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
|
||||
|
|
|
|||
|
|
@ -112,13 +112,16 @@ 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)))
|
||||
(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
|
||||
|
|
|
|||
|
|
@ -40,7 +40,8 @@
|
|||
(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)))
|
||||
|
|
@ -57,6 +58,11 @@
|
|||
(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))
|
||||
|
||||
|
|
@ -99,7 +105,7 @@
|
|||
(if (and (cdr current)
|
||||
(fuel-con--request-deactivated-p (cdr current)))
|
||||
(fuel-con--connection-pop-request c)
|
||||
current)))
|
||||
(cdr current))))
|
||||
|
||||
|
||||
;;; Connection setup:
|
||||
|
|
@ -112,7 +118,9 @@
|
|||
|
||||
(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))
|
||||
|
||||
|
||||
;;; Logging:
|
||||
|
|
@ -143,8 +151,10 @@
|
|||
(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))
|
||||
|
|
@ -168,30 +178,41 @@
|
|||
(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)))))
|
||||
|
||||
|
||||
;;; Message sending interface:
|
||||
|
|
|
|||
|
|
@ -97,6 +97,16 @@ buffer in case of errors."
|
|||
(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."
|
||||
|
|
@ -109,17 +119,29 @@ 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))))
|
||||
|
||||
|
||||
;;; Minor mode definition:
|
||||
|
|
@ -173,6 +195,8 @@ interacting with a factor listener is at your disposal.
|
|||
(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)
|
||||
|
|
|
|||
Loading…
Reference in New Issue