From a160e7d32adf42abb22dd0d8c40057b8ceb9dee6 Mon Sep 17 00:00:00 2001 From: "Jose A. Ortega Ruiz" Date: Tue, 23 Dec 2008 22:37:25 +0100 Subject: [PATCH] FUEL: New fuel-update-usings (C-cC-eu) command. --- extra/fuel/fuel.factor | 27 +++-- misc/fuel/README | 1 + misc/fuel/fuel-connection.el | 2 +- misc/fuel/fuel-debug-uses.el | 223 +++++++++++++++++++++++++++++++++++ misc/fuel/fuel-debug.el | 5 +- misc/fuel/fuel-eval.el | 7 +- misc/fuel/fuel-mode.el | 10 ++ misc/fuel/fuel-popup.el | 11 +- 8 files changed, 271 insertions(+), 15 deletions(-) create mode 100644 misc/fuel/fuel-debug-uses.el diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 57387e70be..35ca438f31 100644 --- a/extra/fuel/fuel.factor +++ b/extra/fuel/fuel.factor @@ -1,13 +1,11 @@ ! Copyright (C) 2008 Jose Antonio Ortega Ruiz. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors arrays assocs classes classes.tuple -combinators compiler.units continuations debugger definitions -eval help io io.files io.pathnames io.streams.string kernel -lexer listener listener.private make math math.order memoize -namespaces parser prettyprint prettyprint.config quotations -sequences sets sorting source-files strings summary tools.vocabs -vectors vocabs vocabs.loader vocabs.parser words ; +USING: accessors arrays assocs classes.tuple combinators +compiler.units continuations debugger definitions io io.pathnames +io.streams.string kernel lexer math math.order memoize namespaces +parser prettyprint sequences sets sorting source-files strings summary +tools.vocabs vectors vocabs vocabs.parser words ; IN: fuel @@ -138,8 +136,23 @@ M: source-file fuel-pprint path>> fuel-pprint ; [ (fuel-eval-usings) (fuel-eval-in) (fuel-eval) ] with-string-writer (fuel-end-eval) ; +! Loading files + : fuel-run-file ( path -- ) run-file ; inline +: fuel-with-autouse ( quot -- ) + [ + auto-use? on + [ amended-use get clone fuel-eval-set-result ] print-use-hook set + call + ] curry with-scope ; + +: (fuel-get-uses) ( lines -- ) + [ parse-fresh drop ] curry with-compilation-unit ; inline + +: fuel-get-uses ( lines -- ) + [ (fuel-get-uses) ] curry fuel-with-autouse ; + ! Edit locations : fuel-normalize-loc ( seq -- path line ) diff --git a/misc/fuel/README b/misc/fuel/README index ee835f2c5c..b670eef84d 100644 --- a/misc/fuel/README +++ b/misc/fuel/README @@ -57,6 +57,7 @@ C-cC-eC-r is the same as C-cC-er)). - M-. : edit word at point in Emacs - M-TAB : complete word at point + - C-cC-eu : update USING: line - C-cC-ev : edit vocabulary (M-x fuel-edit-vocabulary) - C-cC-ew : edit word (M-x fuel-edit-word-at-point) - C-cC-ed : edit word's doc (M-x fuel-edit-word-at-point) diff --git a/misc/fuel/fuel-connection.el b/misc/fuel/fuel-connection.el index d029f6a056..05ddad4b1e 100644 --- a/misc/fuel/fuel-connection.el +++ b/misc/fuel/fuel-connection.el @@ -235,7 +235,7 @@ (not (fuel-con--connection-completed-p con id))) (accept-process-output nil waitsecs) (setq time (- time step))) - (error (setq time 1))) + (error (setq time 0))) (or (> time 0) (fuel-con--request-deactivate req) nil))))) diff --git a/misc/fuel/fuel-debug-uses.el b/misc/fuel/fuel-debug-uses.el new file mode 100644 index 0000000000..03a3de5b8b --- /dev/null +++ b/misc/fuel/fuel-debug-uses.el @@ -0,0 +1,223 @@ +;;; fuel-debug-uses.el -- retrieving USING: stanzas + +;; Copyright (C) 2008 Jose Antonio Ortega Ruiz +;; See http://factorcode.org/license.txt for BSD license. + +;; Author: Jose Antonio Ortega Ruiz +;; Keywords: languages, fuel, factor +;; Start date: Tue Dec 23, 2008 04:23 + +;;; Comentary: + +;; Support for getting and updating factor source vocabulary lists. + +;;; Code: + +(require 'fuel-debug) +(require 'fuel-eval) +(require 'fuel-popup) +(require 'fuel-font-lock) +(require 'fuel-base) + + + +;;; Customization: + +(fuel-font-lock--defface fuel-font-lock-debug-missing-vocab + 'font-lock-warning-face fuel-debug "missing vocabulary names") + +(fuel-font-lock--defface fuel-font-lock-debug-unneeded-vocab + 'font-lock-warning-face fuel-debug "unneeded vocabulary names") + +(fuel-font-lock--defface fuel-font-lock-debug-uses-header + 'bold fuel-debug "headers in Uses buffers") + + +;;; Utility functions: + +(defsubst fuel-debug--at-eou-p () + (looking-at ".*\\_<;\\_>")) + +(defun fuel-debug--file-lines (file) + (when (file-readable-p file) + (with-current-buffer (find-file-noselect file) + (save-excursion + (goto-char (point-min)) + (let ((lines) (in-usings)) + (while (not (eobp)) + (when (looking-at "^USING: ") (setq in-usings t)) + (unless in-usings + (let ((line (substring-no-properties (thing-at-point 'line) 0 -1))) + (unless (or (empty-string-p line) + (fuel--string-prefix-p "! " line)) + (push line lines)))) + (when (and in-usings (fuel-debug--at-eou-p)) (setq in-usings nil)) + (forward-line)) + (reverse lines)))))) + +(defun fuel-debug--highlight-names (names ref face) + (dolist (n names) + (when (not (member n ref)) + (put-text-property 0 (length n) 'face face n)))) + +(defun fuel-debug--uses-new-uses (file uses) + (pop-to-buffer (find-file-noselect file)) + (goto-char (point-min)) + (if (re-search-forward "^USING: " nil t) + (let ((begin (point)) + (end (or (and (re-search-forward "\\_<;\\_>") (point)) (point)))) + (kill-region begin end)) + (re-search-forward "^IN: " nil t) + (beginning-of-line) + (open-line 2) + (insert "USING: ")) + (insert (mapconcat 'identity uses " ") " ;") + (fill-paragraph nil)) + +(defun fuel-debug--uses-filter (restarts) + (let ((result) (i 1) (rn 0)) + (dolist (r restarts (reverse result)) + (setq rn (1+ rn)) + (when (string-match "Use the .+ vocabulary\\|Defer" r) + (push (list i rn r) result) + (setq i (1+ i)))))) + + +;;; Retrieving USINGs: + +(fuel-popup--define fuel-debug--uses-buffer + "*fuel uses*" 'fuel-debug-uses-mode) + +(make-variable-buffer-local + (defvar fuel-debug--uses nil)) + +(make-variable-buffer-local + (defvar fuel-debug--uses-file nil)) + +(make-variable-buffer-local + (defvar fuel-debug--uses-restarts nil)) + +(defsubst fuel-debug--uses-insert-title () + (insert "Infering USING: stanza for " fuel-debug--uses-file ".\n\n")) + +(defun fuel-debug--uses-prepare (file) + (fuel--with-popup (fuel-debug--uses-buffer) + (setq fuel-debug--uses-file file + fuel-debug--uses nil + fuel-debug--uses-restarts nil) + (erase-buffer) + (fuel-debug--uses-insert-title))) + +(defun fuel-debug--uses-clean () + (setq fuel-debug--uses-file nil + fuel-debug--uses nil + fuel-debug--uses-restarts nil)) + +(defun fuel-debug--uses-for-file (file) + (let* ((lines (fuel-debug--file-lines file)) + (cmd `(:fuel ((V{ ,@lines } fuel-get-uses)) t t))) + (fuel-debug--uses-prepare file) + (fuel--with-popup (fuel-debug--uses-buffer) + (insert "Asking Factor. Please, wait ...\n") + (fuel-eval--send cmd 'fuel-debug--uses-cont)) + (fuel-popup--display (fuel-debug--uses-buffer)))) + +(defun fuel-debug--uses-cont (retort) + (let ((uses (fuel-eval--retort-result retort)) + (err (fuel-eval--retort-error retort))) + (if uses (fuel-debug--uses-display uses) + (fuel-debug--uses-display-err retort)))) + +(defun fuel-debug--insert-vlist (title vlist) + (goto-char (point-max)) + (insert title "\n\n ") + (let ((i 0) (step 5)) + (dolist (v vlist) + (setq i (1+ i)) + (insert v) + (insert (if (zerop (mod i step)) "\n " " "))) + (unless (zerop (mod i step)) (newline)) + (newline))) + +(defun fuel-debug--uses-display (uses) + (let* ((inhibit-read-only t) + (old (with-current-buffer (find-file-noselect fuel-debug--uses-file) + (fuel-syntax--usings))) + (old (sort old 'string<)) + (new (sort uses 'string<))) + (erase-buffer) + (fuel-debug--uses-insert-title) + (if (equalp old new) + (progn + (insert "Current USING: is already fine!. Type 'q' to bury buffer.\n") + (fuel-debug--uses-clean)) + (fuel-debug--highlight-names old new 'fuel-font-lock-debug-unneeded-vocab) + (fuel-debug--highlight-names new old 'fuel-font-lock-debug-missing-vocab) + (fuel-debug--insert-vlist "Current vocabulary list:" old) + (newline) + (fuel-debug--insert-vlist "Correct vocabulary list:" new) + (setq fuel-debug--uses new) + (insert "\nType 'y' to update your USING: to the new one.\n")))) + +(defun fuel-debug--uses-display-err (retort) + (let* ((inhibit-read-only t) + (err (fuel-eval--retort-error retort)) + (restarts (fuel-debug--uses-filter (fuel-eval--error-restarts err))) + (unique (= 1 (length restarts)))) + (erase-buffer) + (fuel-debug--uses-insert-title) + (insert (fuel-eval--retort-output retort)) + (newline) + (if (not restarts) + (insert "\nSorry, couldn't infer the vocabulary list.\n") + (setq fuel-debug--uses-restarts restarts) + (if unique (fuel-debug--uses-restart 1) + (insert "\nPlease, type the number of the desired vocabulary:\n\n") + (dolist (r restarts) + (insert (format " :%s %s\n" (first r) (third r)))))))) + +(defun fuel-debug--uses-update-usings () + (interactive) + (let ((inhibit-read-only t)) + (when (and fuel-debug--uses-file fuel-debug--uses) + (fuel-debug--uses-new-uses fuel-debug--uses-file fuel-debug--uses) + (message "USING: updated!") + (with-current-buffer (fuel-debug--uses-buffer) + (insert "\n Done!") + (fuel-debug--uses-clean) + (fuel-popup--quit))))) + +(defun fuel-debug--uses-restart (n) + (when (and (> n 0) (<= n (length fuel-debug--uses-restarts))) + (let* ((inhibit-read-only t) + (restart (format ":%s" (cadr (nth (1- n) fuel-debug--uses-restarts)))) + (cmd `(:fuel ([ (:factor ,restart) ] fuel-with-autouse) t t))) + (setq fuel-debug--uses-restarts nil) + (insert "\nAsking Factor. Please, wait ...\n") + (fuel-eval--send cmd 'fuel-debug--uses-cont)))) + + +;;; Fuel uses mode: + +(defvar fuel-debug-uses-mode-map + (let ((map (make-keymap))) + (suppress-keymap map) + (dotimes (n 9) + (define-key map (vector (+ ?1 n)) + `(lambda () (interactive) (fuel-debug--uses-restart ,(1+ n))))) + (define-key map "y" 'fuel-debug--uses-update-usings) + (define-key map "\C-c\C-c" 'fuel-debug--uses-update-usings) + map)) + +(defun fuel-debug-uses-mode () + "A major mode for displaying Factor's USING: inference results." + (interactive) + (kill-all-local-variables) + (buffer-disable-undo) + (setq major-mode 'fuel-debug-uses-mode) + (setq mode-name "Fuel Uses:") + (use-local-map fuel-debug-uses-mode-map)) + + +(provide 'fuel-debug-uses) +;;; fuel-debug-uses.el ends here diff --git a/misc/fuel/fuel-debug.el b/misc/fuel/fuel-debug.el index 9786590514..f376bde1c9 100644 --- a/misc/fuel/fuel-debug.el +++ b/misc/fuel/fuel-debug.el @@ -239,7 +239,6 @@ (define-key map "\C-c\C-c" 'fuel-debug-goto-error) (define-key map "n" 'next-line) (define-key map "p" 'previous-line) - (define-key map "q" 'bury-buffer) (dotimes (n 9) (define-key map (vector (+ ?1 n)) `(lambda () (interactive) (fuel-debug-exec-restart ,(1+ n) t)))) @@ -255,15 +254,15 @@ invoking restarts as needed. (interactive) (kill-all-local-variables) (buffer-disable-undo) - (setq major-mode 'factor-mode) + (setq major-mode 'fuel-debug-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) - (setq buffer-read-only t) (run-hooks 'fuel-debug-mode-hook)) + (provide 'fuel-debug) ;;; fuel-debug.el ends here diff --git a/misc/fuel/fuel-eval.el b/misc/fuel/fuel-eval.el index 32073f9053..204e794925 100644 --- a/misc/fuel/fuel-eval.el +++ b/misc/fuel/fuel-eval.el @@ -130,14 +130,15 @@ (defsubst fuel-eval--error-name (err) (car err)) -(defsubst fuel-eval--error-restarts (err) - (cdr (assoc :restarts (fuel-eval--error-name-p err 'condition)))) - (defun fuel-eval--error-name-p (err name) (unless (null err) (or (and (eq (fuel-eval--error-name err) name) err) (assoc name err)))) +(defsubst fuel-eval--error-restarts (err) + (cdr (assoc :restarts (or (fuel-eval--error-name-p err 'condition) + (fuel-eval--error-name-p err 'lexer-error))))) + (defsubst fuel-eval--error-file (err) (nth 1 (fuel-eval--error-name-p err 'source-file-error))) diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index 1b46b2bc91..1074f60f5f 100644 --- a/misc/fuel/fuel-mode.el +++ b/misc/fuel/fuel-mode.el @@ -17,6 +17,7 @@ (require 'fuel-listener) (require 'fuel-completion) (require 'fuel-debug) +(require 'fuel-debug-uses) (require 'fuel-eval) (require 'fuel-help) (require 'fuel-xref) @@ -122,6 +123,14 @@ buffer in case of errors." (unless (< begin end) (error "No evaluable definition around point")) (fuel-eval-region begin end arg)))) +(defun fuel-update-usings (&optional arg) + "Asks factor for the vocabularies needed by this file, +optionally updating the its USING: line. +With prefix argument, ask for the file name." + (interactive "P") + (let ((file (car (fuel-mode--read-file arg)))) + (when file (fuel-debug--uses-for-file file)))) + (defun fuel--try-edit (ret) (let* ((err (fuel-eval--retort-error ret)) (loc (fuel-eval--retort-result ret))) @@ -272,6 +281,7 @@ interacting with a factor listener is at your disposal. (fuel-mode--key ?e ?e 'fuel-eval-extended-region) (fuel-mode--key ?e ?l 'fuel-run-file) (fuel-mode--key ?e ?r 'fuel-eval-region) +(fuel-mode--key ?e ?u 'fuel-update-usings) (fuel-mode--key ?e ?v 'fuel-edit-vocabulary) (fuel-mode--key ?e ?w 'fuel-edit-word) (fuel-mode--key ?e ?x 'fuel-eval-definition) diff --git a/misc/fuel/fuel-popup.el b/misc/fuel/fuel-popup.el index f18e77b321..b8a967d3b0 100644 --- a/misc/fuel/fuel-popup.el +++ b/misc/fuel/fuel-popup.el @@ -44,7 +44,8 @@ (define-minor-mode fuel-popup-mode "Mode for displaying read only stuff" nil nil - '(("q" . fuel-popup--quit))) + '(("q" . fuel-popup--quit)) + (setq buffer-read-only t)) (defmacro fuel-popup--define (fun name mode) `(defun ,fun () @@ -55,6 +56,14 @@ (current-buffer))))) (put 'fuel-popup--define 'lisp-indent-function 1) + +(defmacro fuel--with-popup (buffer &rest body) + `(with-current-buffer ,buffer + (let ((inhibit-read-only t)) + ,@body))) + +(put 'fuel--with-popup 'lisp-indent-function 1) + (provide 'fuel-popup) ;;; fuel-popup.el ends here