1 ;;; fuel-debug-uses.el -- retrieving USING: stanzas
3 ;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
4 ;; See http://factorcode.org/license.txt for BSD license.
6 ;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
7 ;; Keywords: languages, fuel, factor
8 ;; Start date: Tue Dec 23, 2008 04:23
12 ;; Support for getting and updating factor source vocabulary lists.
26 (defgroup fuel-debug-uses nil
27 "Customization for FUEL's debug uses."
30 (defface fuel-debug-uses-header-face '((t (:inherit header)))
31 "Header face for FUEL's debug uses."
32 :group 'fuel-debug-uses
36 (defface fuel-debug-uses-prompt-face '((t (:inherit comint-highlight-prompt)))
37 "Prompt face for FUEL's debug uses."
38 :group 'fuel-debug-uses
43 ;;; Utility functions:
45 (defsubst fuel-debug--chomp (s)
46 (replace-regexp-in-string "[\n\r\f]" "" s))
48 (defun fuel-debug--file-lines (file)
49 (when (file-readable-p file)
50 (with-current-buffer (find-file-noselect file)
52 (goto-char (point-min))
53 (let ((lines) (in-usings))
55 (when (looking-at "^USING: ") (setq in-usings t))
56 (let ((line (fuel-debug--chomp
57 (substring-no-properties (thing-at-point 'line)))))
58 (when in-usings (setq line (concat "! " line)))
60 (when (and in-usings (looking-at "\\(^\\|.* \\);\\( \\|\n\\)"))
65 (defun fuel-debug--uses-filter (restarts)
66 (let ((result) (i 1) (rn 0))
67 (dolist (r restarts (reverse result))
69 (when (string-match "Use the .+ vocabulary\\|Defer" r)
70 (push (list i rn r) result)
74 ;;; Retrieving USINGs:
76 (defun fuel-debug--uses-buffer ()
77 (or (get-buffer "*fuel uses*")
78 (with-current-buffer (get-buffer-create "*fuel uses*")
79 (fuel-debug-uses-mode)
83 (defvar-local fuel-debug--uses-file nil)
85 (defvar-local fuel-debug--uses-restarts nil)
87 (defsubst fuel-debug--uses-insert-title ()
88 (insert "Inferring USING: stanza for " fuel-debug--uses-file ".\n\n"))
90 (defun fuel-debug--uses-prepare (file)
91 (with-current-buffer (fuel-debug--uses-buffer)
92 (let ((inhibit-read-only t))
93 (setq fuel-debug--uses-file file
95 fuel-debug--uses-restarts nil)
97 (fuel-debug--uses-insert-title))))
99 (defun fuel-debug--uses-clean ()
100 (setq fuel-debug--uses-file nil
102 fuel-debug--uses-restarts nil))
104 (defun fuel-debug--current-usings (file)
105 (with-current-buffer (find-file-noselect file)
106 (sort (factor-find-usings t) 'string<)))
108 (defun fuel-debug--uses-for-file (file)
109 (let* ((lines (fuel-debug--file-lines file))
110 (old-usings (fuel-debug--current-usings file))
111 (cmd `(:fuel ((V{ ,@old-usings }
112 [ V{ ,@lines } fuel-get-uses ]
113 fuel-use-suggested-vocabs)) t t)))
114 (fuel-debug--uses-prepare file)
115 (with-current-buffer (fuel-debug--uses-buffer)
116 (let ((inhibit-read-only t))
117 (insert "Asking Factor. Please, wait...\n")
118 (fuel-eval--send cmd 'fuel-debug--uses-cont)))
119 (fuel-popup--display (fuel-debug--uses-buffer))))
121 (defun fuel-debug--uses-cont (retort)
122 (let ((uses (fuel-debug--uses retort))
123 (err (fuel-eval--retort-error retort)))
124 (if uses (fuel-debug--uses-display uses)
125 (fuel-debug--uses-display-err retort))))
127 (defun fuel-debug--uses-display (uses)
128 (let* ((inhibit-read-only t)
129 (old (fuel-debug--current-usings fuel-debug--uses-file))
130 (new (sort uses 'string<)))
132 (fuel-debug--uses-insert-title)
133 (if (cl-equalp old new)
135 (insert "Current USING: is already fine!. Type 'q' to bury buffer.\n")
136 (fuel-debug--uses-clean))
137 (fuel-debug--highlight-names old new 'fuel-font-lock-debug-unneeded-vocab)
138 (fuel-debug--highlight-names new old 'fuel-font-lock-debug-missing-vocab)
139 (fuel-debug--insert-vlist "Current vocabulary list:" old)
141 (fuel-debug--insert-vlist "Correct vocabulary list:" new)
142 (setq fuel-debug--uses new)
143 (insert "\nType 'y' to update your USING: to the new one.\n"))))
145 (defun fuel-debug--uses-display-err (retort)
146 (let* ((inhibit-read-only t)
147 (err (fuel-eval--retort-error retort))
148 (restarts (fuel-debug--uses-filter (fuel-eval--error-restarts err)))
149 (unique (= 1 (length restarts))))
151 (fuel-debug--uses-insert-title)
152 (insert (fuel-eval--retort-output retort))
155 (insert "\nSorry, couldn't infer the vocabulary list.\n")
156 (setq fuel-debug--uses-restarts restarts)
157 (if unique (fuel-debug--uses-restart 1)
158 (insert "\nPlease, type the number of the desired vocabulary:\n\n")
160 (insert (format " :%s %s\n" (cl-first r) (cl-third r))))))))
162 (defun fuel-debug--uses-update-usings ()
164 (let ((inhibit-read-only t)
165 (file fuel-debug--uses-file)
166 (uses fuel-debug--uses))
167 (when (and uses file)
169 (fuel-debug--uses-clean)
171 (fuel-debug--replace-usings file uses)
172 (message "USING: updated!"))))
174 (defun fuel-debug--uses-restart (n)
175 (when (and (> n 0) (<= n (length fuel-debug--uses-restarts)))
176 (let* ((inhibit-read-only t)
177 (restart (format ":%s" (cadr (nth (1- n) fuel-debug--uses-restarts))))
178 (cmd `(:fuel ([ (:factor ,restart) ] fuel-with-autouse) t t)))
179 (setq fuel-debug--uses-restarts nil)
180 (insert "\nAsking Factor. Please, wait ...\n")
181 (fuel-eval--send cmd 'fuel-debug--uses-cont))))
186 (defconst fuel-debug--uses-header-regex
188 (regexp-opt '("Inferring USING: stanza for "
189 "Current USING: is already fine!"
190 "Current vocabulary list:"
191 "Correct vocabulary list:"
192 "Sorry, couldn't infer the vocabulary list."
195 (defconst fuel-debug--uses-prompt-regex
197 (regexp-opt '("Asking Factor. Please, wait ..."
198 "Please, type the number of the desired vocabulary:"
199 "Type 'y' to update your USING: to the new one."))))
201 (defconst fuel-debug--uses-font-lock-keywords
202 `((,fuel-debug--uses-header-regex . 'fuel-debug-uses-header-face)
203 (,fuel-debug--uses-prompt-regex . 'fuel-debug-uses-prompt-face)
204 (,fuel-debug--restart-regex (1 'fuel-font-lock-debug-restart-number)
205 (2 'fuel-font-lock-debug-restart-name))))
207 (defvar fuel-debug-uses-mode-map
208 (let ((map (make-keymap)))
209 (suppress-keymap map)
211 (define-key map (vector (+ ?1 n))
212 `(lambda () (interactive) (fuel-debug--uses-restart ,(1+ n)))))
213 (define-key map "y" 'fuel-debug--uses-update-usings)
214 (define-key map "\C-c\C-c" 'fuel-debug--uses-update-usings)
218 (define-derived-mode fuel-debug-uses-mode fundamental-mode "FUEL Uses"
219 "A major mode for displaying Factor's USING: inference results.
220 \\{fuel-debug-uses-mode-map}"
221 (buffer-disable-undo)
222 (setq font-lock-defaults
223 '(fuel-debug--uses-font-lock-keywords t nil nil nil)))
226 (provide 'fuel-debug-uses)
228 ;;; fuel-debug-uses.el ends here