From 8be42496b3722a36e316a3d10cbcc2e53325a535 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sat, 13 Dec 2008 03:40:36 +0100 Subject: [PATCH 1/2] FUEL: Ooops, infinite recursion fix. --- misc/fuel/fuel-connection.el | 68 +++++++++++++++++++++++++++++------- misc/fuel/fuel-debug.el | 3 +- misc/fuel/fuel-help.el | 3 +- 3 files changed, 60 insertions(+), 14 deletions(-) diff --git a/misc/fuel/fuel-connection.el b/misc/fuel/fuel-connection.el index 191424589c..247657aa8c 100644 --- a/misc/fuel/fuel-connection.el +++ b/misc/fuel/fuel-connection.el @@ -96,7 +96,8 @@ (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)) + (if (and (cdr current) + (fuel-con--request-deactivated-p (cdr current))) (fuel-con--connection-pop-request c) current))) @@ -113,6 +114,47 @@ (add-hook 'comint-redirect-filter-functions 'fuel-con--comint-redirect-filter t t)) + +;;; 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)))) + +(defsubst fuel-con--log-msg (type &rest args) + (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: @@ -123,30 +165,32 @@ (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))))) + (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))))) + (comint-redirect-send-command str (fuel-con--log-buffer) nil t))))) (defun fuel-con--comint-redirect-filter (str) (if (not fuel-con--connection) - (format "\nERROR: No connection in buffer (%s)\n" str) + (fuel-con--log-error "No connection in buffer (%s)" str) (let ((req (fuel-con--connection-current-request fuel-con--connection))) - (if (not req) (format "\nERROR: No current request (%s)\n" str) + (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) - (format "\nWARNING: Droping result for request %s:%S (%s)\n" - id rstr str) + (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) - (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--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))))))) diff --git a/misc/fuel/fuel-debug.el b/misc/fuel/fuel-debug.el index ad9f47ceb1..a7c06e4b3e 100644 --- a/misc/fuel/fuel-debug.el +++ b/misc/fuel/fuel-debug.el @@ -253,13 +253,14 @@ invoking restarts as needed. \\{fuel-debug-mode-map}" (interactive) (kill-all-local-variables) + (buffer-disable-undo) (setq major-mode 'factor-mode) (setq mode-name "Fuel Debug") (use-local-map fuel-debug-mode-map) (fuel-debug--font-lock-setup) (setq fuel-debug--file nil) (setq fuel-debug--last-ret nil) - (toggle-read-only 1) + (setq buffer-read-only t) (run-hooks 'fuel-debug-mode-hook)) diff --git a/misc/fuel/fuel-help.el b/misc/fuel/fuel-help.el index 227778934a..1d39d1571d 100644 --- a/misc/fuel/fuel-help.el +++ b/misc/fuel/fuel-help.el @@ -261,6 +261,7 @@ buffer." \\{fuel-help-mode-map}" (interactive) (kill-all-local-variables) + (buffer-disable-undo) (use-local-map fuel-help-mode-map) (setq mode-name "Factor Help") (setq major-mode 'fuel-help-mode) @@ -271,7 +272,7 @@ buffer." (fuel-autodoc-mode) (run-mode-hooks 'fuel-help-mode-hook) - (toggle-read-only 1)) + (setq buffer-read-only t)) (provide 'fuel-help) From fbbe8d9e5e09d88eefca0866bbe9d746b20b1c13 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Sun, 14 Dec 2008 00:41:35 +0100 Subject: [PATCH 2/2] FUEL: Edit vocabulary interactive command and bug fixes. --- extra/fuel/fuel.factor | 15 +++++++-- misc/fuel/README | 1 + misc/fuel/factor-mode.el | 15 +++++---- misc/fuel/fuel-connection.el | 65 ++++++++++++++++++++++++------------ misc/fuel/fuel-mode.el | 46 +++++++++++++++++++------ 5 files changed, 100 insertions(+), 42 deletions(-) diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index e2535ade30..6c86889040 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -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 diff --git a/misc/fuel/README b/misc/fuel/README index 4dfb16da51..dc6db388e6 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -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 diff --git a/misc/fuel/factor-mode.el b/misc/fuel/factor-mode.el index b3952074f5..2f73a62738 100644 --- a/misc/fuel/factor-mode.el +++ b/misc/fuel/factor-mode.el @@ -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 diff --git a/misc/fuel/fuel-connection.el b/misc/fuel/fuel-connection.el index 247657aa8c..b72e6843bf 100644 --- a/misc/fuel/fuel-connection.el +++ b/misc/fuel/fuel-connection.el @@ -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: diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index feaea1548e..fbfe614526 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -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)