FUEL: Internal refactorings and cleanups.
Jose A. Ortega Ruiz
parent
04e4ff16f8
commit
b4efb3891b
|
|
@ -14,6 +14,9 @@
|
|||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-base)
|
||||
(require 'fuel-log)
|
||||
|
||||
|
||||
;;; Default connection:
|
||||
|
||||
|
|
@ -122,49 +125,6 @@
|
|||
(add-hook 'comint-redirect-hook
|
||||
'fuel-con--comint-redirect-hook))
|
||||
|
||||
|
||||
;;; Logging:
|
||||
|
||||
(defvar fuel-con--log-size 32000
|
||||
"Maximum size of the Factor messages log.")
|
||||
|
||||
(defvar fuel-con--log-verbose-p t
|
||||
"Log level for Factor messages.")
|
||||
|
||||
(define-derived-mode factor-messages-mode fundamental-mode "Factor Messages"
|
||||
"Simple mode to log interactions with the factor listener"
|
||||
(kill-all-local-variables)
|
||||
(buffer-disable-undo)
|
||||
(set (make-local-variable 'comint-redirect-subvert-readonly) t)
|
||||
(add-hook 'after-change-functions
|
||||
'(lambda (b e len)
|
||||
(let ((inhibit-read-only t))
|
||||
(when (> b fuel-con--log-size)
|
||||
(delete-region (point-min) b))))
|
||||
nil t)
|
||||
(setq buffer-read-only t))
|
||||
|
||||
(defun fuel-con--log-buffer ()
|
||||
(or (get-buffer "*factor messages*")
|
||||
(save-current-buffer
|
||||
(set-buffer (get-buffer-create "*factor messages*"))
|
||||
(factor-messages-mode)
|
||||
(current-buffer))))
|
||||
|
||||
(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))
|
||||
|
||||
(defsubst fuel-con--log-error (&rest args)
|
||||
(apply 'fuel-con--log-msg 'ERROR args))
|
||||
|
||||
(defsubst fuel-con--log-info (&rest args)
|
||||
(if fuel-con--log-verbose-p (apply 'fuel-con--log-msg 'INFO args) ""))
|
||||
|
||||
|
||||
;;; Requests handling:
|
||||
|
||||
|
|
@ -175,11 +135,11 @@
|
|||
(str (and req (fuel-con--request-string req))))
|
||||
(when (and buffer req str)
|
||||
(set-buffer buffer)
|
||||
(when fuel-con--log-verbose-p
|
||||
(with-current-buffer (fuel-con--log-buffer)
|
||||
(when fuel-log--verbose-p
|
||||
(with-current-buffer (fuel-log--buffer)
|
||||
(let ((inhibit-read-only t))
|
||||
(fuel-con--log-info "<%s>: %s" (fuel-con--request-id req) str))))
|
||||
(comint-redirect-send-command str (fuel-con--log-buffer) nil t)))))
|
||||
(fuel-log--info "<%s>: %s" (fuel-con--request-id req) str))))
|
||||
(comint-redirect-send-command str (fuel-log--buffer) nil t)))))
|
||||
|
||||
(defun fuel-con--process-completed-request (req)
|
||||
(let ((str (fuel-con--request-output req))
|
||||
|
|
@ -188,29 +148,29 @@
|
|||
(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)"
|
||||
(fuel-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"
|
||||
(fuel-log--info "<%s>: processed\n\t%s" id str))
|
||||
(error (fuel-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)
|
||||
(fuel-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)
|
||||
(if (not req) (fuel-log--error "No current request (%s)" str)
|
||||
(fuel-con--request-output req str)
|
||||
(fuel-con--log-info "<%s>: in progress" (fuel-con--request-id req)))))
|
||||
".\n")
|
||||
(fuel-log--info "<%s>: in progress" (fuel-con--request-id req)))))
|
||||
".")
|
||||
|
||||
(defun fuel-con--comint-redirect-hook ()
|
||||
(if (not fuel-con--connection)
|
||||
(fuel-con--log-error "No connection in buffer")
|
||||
(fuel-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)
|
||||
(if (not req) (fuel-log--error "No current request (%s)" str)
|
||||
(fuel-con--process-completed-request req)
|
||||
(fuel-con--connection-clean-current-request fuel-con--connection)))))
|
||||
|
||||
|
|
|
|||
|
|
@ -214,7 +214,7 @@
|
|||
(buffer (if file (find-file-noselect file) (current-buffer))))
|
||||
(with-current-buffer buffer
|
||||
(fuel-debug--display-retort
|
||||
(fuel-eval--send/wait (fuel-eval--cmd/string (format ":%s" n)))
|
||||
(fuel-eval--send/wait `(:fuel ((:factor ,(format ":%s" n)))))
|
||||
(format "Restart %s (%s) successful" n (nth (1- n) rs))))))))
|
||||
|
||||
(defun fuel-debug-show--compiler-info (info)
|
||||
|
|
@ -224,7 +224,7 @@
|
|||
(error "%s information not available" info))
|
||||
(message "Retrieving %s info ..." info)
|
||||
(unless (fuel-debug--display-retort
|
||||
(fuel-eval--send/wait (fuel-eval--cmd/string info))
|
||||
(fuel-eval--send/wait `(:fuel ((:factor ,info))))
|
||||
"" (fuel-debug--buffer-file))
|
||||
(error "Sorry, no %s info available" info))))
|
||||
|
||||
|
|
|
|||
|
|
@ -17,6 +17,93 @@
|
|||
(require 'fuel-syntax)
|
||||
(require 'fuel-connection)
|
||||
|
||||
|
||||
;;; Simple sexp-based representation of factor code
|
||||
|
||||
(defun factor (sexp)
|
||||
(cond ((null sexp) "f")
|
||||
((eq sexp t) "t")
|
||||
((or (stringp sexp) (numberp sexp)) (format "%S" sexp))
|
||||
((vectorp sexp) (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)))
|
||||
(:factor (format "%s" (mapconcat 'identity (cdr sexp) " ")))
|
||||
(:fuel (factor--fuel-factor (cons :rs (cdr sexp))))
|
||||
(:fuel* (factor--fuel-factor (cons :nrs (cdr sexp))))
|
||||
(t (mapconcat 'factor sexp " "))))
|
||||
((keywordp sexp)
|
||||
(factor (case sexp
|
||||
(:rs 'fuel-eval-restartable)
|
||||
(:nrs 'fuel-eval-non-restartable)
|
||||
(:in (fuel-syntax--current-vocab))
|
||||
(:usings `(:array ,@(fuel-syntax--usings-update)))
|
||||
(:get 'fuel-eval-set-result)
|
||||
(t `(:factor ,(symbol-name sexp))))))
|
||||
((symbolp sexp) (symbol-name sexp))))
|
||||
|
||||
(defsubst factor--seq (begin end forms)
|
||||
(format "%s %s %s" begin (if forms (factor forms) "") end))
|
||||
|
||||
(defsubst factor--fuel-factor (sexp)
|
||||
(factor `(,(factor--fuel-restart (nth 0 sexp))
|
||||
,(factor--fuel-lines (nth 1 sexp))
|
||||
,(factor--fuel-in (nth 2 sexp))
|
||||
,(factor--fuel-usings (nth 3 sexp))
|
||||
fuel-eval-in-context)))
|
||||
|
||||
(defsubst factor--fuel-restart (rs)
|
||||
(unless (member rs '(:rs :nrs))
|
||||
(error "Invalid restart spec (%s)" rs))
|
||||
rs)
|
||||
|
||||
(defsubst factor--fuel-lines (lst)
|
||||
(cons :array (mapcar 'factor lst)))
|
||||
|
||||
(defsubst factor--fuel-in (in)
|
||||
(cond ((null in) :in)
|
||||
((eq in t) "fuel-scratchpad")
|
||||
((stringp in) in)
|
||||
(t (error "Invalid 'in' (%s)" in))))
|
||||
|
||||
(defsubst factor--fuel-usings (usings)
|
||||
(cond ((null usings) :usings)
|
||||
((eq usings t) nil)
|
||||
((listp usings) `(:array ,@usings))
|
||||
(t (error "Invalid 'usings' (%s)" usings))))
|
||||
|
||||
|
||||
|
||||
;;; Code sending:
|
||||
|
||||
(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--sync-retort nil)
|
||||
|
||||
(defun fuel-eval--send/wait (code &optional timeout buffer)
|
||||
(setq fuel-eval--sync-retort nil)
|
||||
(fuel-con--send-string/wait (or fuel-eval--proc (fuel-eval--default-proc))
|
||||
(if (stringp code) code (factor code))
|
||||
'(lambda (s)
|
||||
(setq fuel-eval--sync-retort
|
||||
(fuel-eval--parse-retort s)))
|
||||
timeout
|
||||
buffer)
|
||||
fuel-eval--sync-retort)
|
||||
|
||||
(defun fuel-eval--send (code cont &optional buffer)
|
||||
(fuel-con--send-string (or fuel-eval--proc (fuel-eval--default-proc))
|
||||
(if (stringp code) code (factor code))
|
||||
`(lambda (s) (,cont (fuel-eval--parse-retort s)))
|
||||
buffer))
|
||||
|
||||
|
||||
;;; Retort and retort-error datatypes:
|
||||
|
||||
|
|
@ -64,69 +151,6 @@
|
|||
(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
|
||||
|
|
|
|||
|
|
@ -75,8 +75,7 @@
|
|||
(let ((word (or word (fuel-syntax-symbol-at-point)))
|
||||
(fuel-eval--log t))
|
||||
(when word
|
||||
(let* ((str (format "\\ %s synopsis fuel-eval-set-result" word))
|
||||
(cmd (fuel-eval--cmd/string str t t))
|
||||
(let* ((cmd `(:fuel* (((:quote ,word) synopsis :get)) t))
|
||||
(ret (fuel-eval--send/wait cmd 20)))
|
||||
(when (and ret (not (fuel-eval--retort-error ret)))
|
||||
(if fuel-help-minibuffer-font-lock
|
||||
|
|
@ -151,10 +150,9 @@ displayed in the minibuffer."
|
|||
fuel-help-always-ask))
|
||||
(def (if ask (read-string prompt nil 'fuel-help--prompt-history def)
|
||||
def))
|
||||
(cmd (format "\\ %s %s" def (if see "see" "help"))))
|
||||
(cmd `(:fuel* ((:quote ,def) ,(if see 'see 'help)) t)))
|
||||
(message "Looking up '%s' ..." def)
|
||||
(fuel-eval--send (fuel-eval--cmd/string cmd t t)
|
||||
`(lambda (r) (fuel-help--show-help-cont ,def r)))))
|
||||
(fuel-eval--send cmd `(lambda (r) (fuel-help--show-help-cont ,def r)))))
|
||||
|
||||
(defun fuel-help--show-help-cont (def ret)
|
||||
(let ((out (fuel-eval--retort-output ret)))
|
||||
|
|
|
|||
|
|
@ -0,0 +1,72 @@
|
|||
;;; fuel-log.el -- logging 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 01:00
|
||||
|
||||
;;; Comentary:
|
||||
|
||||
;; Some utilities for maintaining a simple log buffer, mainly for
|
||||
;; debugging purposes.
|
||||
|
||||
;;; Code:
|
||||
|
||||
(require 'fuel-base)
|
||||
|
||||
|
||||
;;; Customization:
|
||||
|
||||
(defvar fuel-log--buffer-name "*fuel messages*"
|
||||
"Name of the log buffer")
|
||||
|
||||
(defvar fuel-log--max-buffer-size 32000
|
||||
"Maximum size of the Factor messages log")
|
||||
|
||||
(defvar fuel-log--max-message-size 512
|
||||
"Maximum size of individual log messages")
|
||||
|
||||
(defvar fuel-log--verbose-p t
|
||||
"Log level for Factor messages")
|
||||
|
||||
(define-derived-mode factor-messages-mode fundamental-mode "FUEL Messages"
|
||||
"Simple mode to log interactions with the factor listener"
|
||||
(kill-all-local-variables)
|
||||
(buffer-disable-undo)
|
||||
(set (make-local-variable 'comint-redirect-subvert-readonly) t)
|
||||
(add-hook 'after-change-functions
|
||||
'(lambda (b e len)
|
||||
(let ((inhibit-read-only t))
|
||||
(when (> b fuel-log--max-buffer-size)
|
||||
(delete-region (point-min) b))))
|
||||
nil t)
|
||||
(setq buffer-read-only t))
|
||||
|
||||
(defun fuel-log--buffer ()
|
||||
(or (get-buffer fuel-log--buffer-name)
|
||||
(save-current-buffer
|
||||
(set-buffer (get-buffer-create fuel-log--buffer-name))
|
||||
(factor-messages-mode)
|
||||
(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)))))
|
||||
|
||||
(defsubst fuel-log--warn (&rest args)
|
||||
(apply 'fuel-log--msg 'WARNING args))
|
||||
|
||||
(defsubst fuel-log--error (&rest args)
|
||||
(apply 'fuel-log--msg 'ERROR args))
|
||||
|
||||
(defsubst fuel-log--info (&rest args)
|
||||
(if fuel-log--verbose-p (apply 'fuel-log--msg 'INFO args) ""))
|
||||
|
||||
|
||||
(provide 'fuel-log)
|
||||
;;; fuel-log.el ends here
|
||||
|
|
@ -49,7 +49,7 @@ With prefix argument, ask for the file to run."
|
|||
(when buffer
|
||||
(with-current-buffer buffer
|
||||
(message "Compiling %s ..." file)
|
||||
(fuel-eval--send (fuel-eval--cmd/string (format "%S fuel-run-file" file))
|
||||
(fuel-eval--send `(:fuel (,file fuel-run-file))
|
||||
`(lambda (r) (fuel--run-file-cont r ,file)))))))
|
||||
|
||||
(defun fuel--run-file-cont (ret file)
|
||||
|
|
@ -65,15 +65,18 @@ With prefix argument, ask for the file to run."
|
|||
Unless called with a prefix, switchs to the compilation results
|
||||
buffer in case of errors."
|
||||
(interactive "r\nP")
|
||||
(fuel-debug--display-retort
|
||||
(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)
|
||||
"")
|
||||
(fuel--shorten-region begin end 70))
|
||||
arg
|
||||
(buffer-file-name)))
|
||||
(let* ((lines (split-string (buffer-substring-no-properties begin end)
|
||||
"[\f\n\r\v]+" t))
|
||||
(cmd `(:fuel (,(mapcar (lambda (l) `(:factor ,l)) lines)))))
|
||||
(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)
|
||||
"")
|
||||
(fuel--shorten-region begin end 70))
|
||||
arg
|
||||
(buffer-file-name))))
|
||||
|
||||
(defun fuel-eval-extended-region (begin end &optional arg)
|
||||
"Sends region extended outwards to nearest definitions,
|
||||
|
|
@ -119,17 +122,16 @@ 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))))
|
||||
(let ((cmd `(:fuel ((:quote ,word) fuel-get-edit-location))))
|
||||
(condition-case nil
|
||||
(fuel--try-edit (fuel-eval--send/wait str))
|
||||
(fuel--try-edit (fuel-eval--send/wait cmd))
|
||||
(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)))
|
||||
(let* ((cmd '(:fuel* (fuel-get-vocabs) "fuel" t))
|
||||
(vocabs (fuel-eval--retort-result (fuel-eval--send/wait cmd)))
|
||||
(prompt "Vocabulary name: "))
|
||||
(if vocabs
|
||||
(completing-read prompt vocabs nil t nil fuel--vocabs-prompt-history)
|
||||
|
|
@ -139,9 +141,8 @@ With prefix, asks for the word to edit."
|
|||
"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))))
|
||||
(let* ((cmd `(:fuel* (,vocab fuel-get-vocab-location) "fuel" t)))
|
||||
(fuel--try-edit (fuel-eval--send/wait cmd))))
|
||||
|
||||
|
||||
;;; Minor mode definition:
|
||||
|
|
|
|||
|
|
@ -259,7 +259,8 @@
|
|||
|
||||
(defun fuel-syntax--usings-update ()
|
||||
(save-excursion
|
||||
(setq fuel-syntax--usings (list (fuel-syntax--current-vocab)))
|
||||
(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)))
|
||||
|
|
|
|||
Loading…
Reference in New Issue