;;; Code:
+(require 'fuel-base)
+(require 'fuel-log)
+
\f
;;; Default connection:
(add-hook 'comint-redirect-hook
'fuel-con--comint-redirect-hook))
-\f
-;;; 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) ""))
-
\f
;;; Requests handling:
(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))
(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)))))
(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)
(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))))
(require 'fuel-syntax)
(require 'fuel-connection)
+\f
+;;; 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))))
+
+
+\f
+;;; 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))
+
\f
;;; Retort and retort-error datatypes:
(defsubst fuel-eval--error-line-text (err)
(nth 3 (fuel-eval--error-lexer-p err)))
-\f
-;;; 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))
-
-\f
-;;; 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))))
-
-
\f
(provide 'fuel-eval)
;;; fuel-eval.el ends here
(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
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)))
--- /dev/null
+;;; 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)
+
+\f
+;;; 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) ""))
+
+\f
+(provide 'fuel-log)
+;;; fuel-log.el ends here
(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)
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,
(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)
"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))))
\f
;;; Minor mode definition:
(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)))
projects / factor.git / commitdiff