1 ;;; fuel-debug-uses.el -- retrieving USING: stanzas
3 ;; Copyright (C) 2008 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.
19 (require 'fuel-font-lock)
26 (fuel-font-lock--defface fuel-font-lock-debug-missing-vocab
27 'font-lock-warning-face fuel-debug "missing vocabulary names")
29 (fuel-font-lock--defface fuel-font-lock-debug-unneeded-vocab
30 'font-lock-warning-face fuel-debug "unneeded vocabulary names")
32 (fuel-font-lock--defface fuel-font-lock-debug-uses-header
33 'bold fuel-debug "headers in Uses buffers")
36 ;;; Utility functions:
38 (defsubst fuel-debug--at-eou-p ()
39 (looking-at ".*\\_<;\\_>"))
41 (defun fuel-debug--file-lines (file)
42 (when (file-readable-p file)
43 (with-current-buffer (find-file-noselect file)
45 (goto-char (point-min))
46 (let ((lines) (in-usings))
48 (when (looking-at "^USING: ") (setq in-usings t))
50 (let ((line (substring-no-properties (thing-at-point 'line) 0 -1)))
51 (unless (or (empty-string-p line)
52 (fuel--string-prefix-p "! " line))
54 (when (and in-usings (fuel-debug--at-eou-p)) (setq in-usings nil))
58 (defun fuel-debug--highlight-names (names ref face)
60 (when (not (member n ref))
61 (put-text-property 0 (length n) 'face face n))))
63 (defun fuel-debug--uses-new-uses (file uses)
64 (pop-to-buffer (find-file-noselect file))
65 (goto-char (point-min))
66 (if (re-search-forward "^USING: " nil t)
68 (end (or (and (re-search-forward "\\_<;\\_>") (point)) (point))))
69 (kill-region begin end))
70 (re-search-forward "^IN: " nil t)
74 (let ((start (point)))
75 (insert (mapconcat 'identity uses " ") " ;")
76 (fill-region start (point) nil)))
78 (defun fuel-debug--uses-filter (restarts)
79 (let ((result) (i 1) (rn 0))
80 (dolist (r restarts (reverse result))
82 (when (string-match "Use the .+ vocabulary\\|Defer" r)
83 (push (list i rn r) result)
87 ;;; Retrieving USINGs:
89 (fuel-popup--define fuel-debug--uses-buffer
90 "*fuel uses*" 'fuel-debug-uses-mode)
92 (make-variable-buffer-local
93 (defvar fuel-debug--uses nil))
95 (make-variable-buffer-local
96 (defvar fuel-debug--uses-file nil))
98 (make-variable-buffer-local
99 (defvar fuel-debug--uses-restarts nil))
101 (defsubst fuel-debug--uses-insert-title ()
102 (insert "Infering USING: stanza for " fuel-debug--uses-file ".\n\n"))
104 (defun fuel-debug--uses-prepare (file)
105 (fuel--with-popup (fuel-debug--uses-buffer)
106 (setq fuel-debug--uses-file file
108 fuel-debug--uses-restarts nil)
110 (fuel-debug--uses-insert-title)))
112 (defun fuel-debug--uses-clean ()
113 (setq fuel-debug--uses-file nil
115 fuel-debug--uses-restarts nil))
117 (defun fuel-debug--uses-for-file (file)
118 (let* ((lines (fuel-debug--file-lines file))
119 (cmd `(:fuel ((V{ ,@lines } fuel-get-uses)) t t)))
120 (fuel-debug--uses-prepare file)
121 (fuel--with-popup (fuel-debug--uses-buffer)
122 (insert "Asking Factor. Please, wait ...\n")
123 (fuel-eval--send cmd 'fuel-debug--uses-cont))
124 (fuel-popup--display (fuel-debug--uses-buffer))))
126 (defun fuel-debug--uses-cont (retort)
127 (let ((uses (fuel-eval--retort-result retort))
128 (err (fuel-eval--retort-error retort)))
129 (if uses (fuel-debug--uses-display uses)
130 (fuel-debug--uses-display-err retort))))
132 (defun fuel-debug--insert-vlist (title vlist)
133 (goto-char (point-max))
134 (insert title "\n\n ")
135 (let ((i 0) (step 5))
139 (insert (if (zerop (mod i step)) "\n " " ")))
140 (unless (zerop (mod i step)) (newline))
143 (defun fuel-debug--uses-display (uses)
144 (let* ((inhibit-read-only t)
145 (old (with-current-buffer (find-file-noselect fuel-debug--uses-file)
146 (fuel-syntax--usings)))
147 (old (sort old 'string<))
148 (new (sort uses 'string<)))
150 (fuel-debug--uses-insert-title)
153 (insert "Current USING: is already fine!. Type 'q' to bury buffer.\n")
154 (fuel-debug--uses-clean))
155 (fuel-debug--highlight-names old new 'fuel-font-lock-debug-unneeded-vocab)
156 (fuel-debug--highlight-names new old 'fuel-font-lock-debug-missing-vocab)
157 (fuel-debug--insert-vlist "Current vocabulary list:" old)
159 (fuel-debug--insert-vlist "Correct vocabulary list:" new)
160 (setq fuel-debug--uses new)
161 (insert "\nType 'y' to update your USING: to the new one.\n"))))
163 (defun fuel-debug--uses-display-err (retort)
164 (let* ((inhibit-read-only t)
165 (err (fuel-eval--retort-error retort))
166 (restarts (fuel-debug--uses-filter (fuel-eval--error-restarts err)))
167 (unique (= 1 (length restarts))))
169 (fuel-debug--uses-insert-title)
170 (insert (fuel-eval--retort-output retort))
173 (insert "\nSorry, couldn't infer the vocabulary list.\n")
174 (setq fuel-debug--uses-restarts restarts)
175 (if unique (fuel-debug--uses-restart 1)
176 (insert "\nPlease, type the number of the desired vocabulary:\n\n")
178 (insert (format " :%s %s\n" (first r) (third r))))))))
180 (defun fuel-debug--uses-update-usings ()
182 (let ((inhibit-read-only t))
183 (when (and fuel-debug--uses-file fuel-debug--uses)
184 (fuel-debug--uses-new-uses fuel-debug--uses-file fuel-debug--uses)
185 (message "USING: updated!")
186 (with-current-buffer (fuel-debug--uses-buffer)
188 (fuel-debug--uses-clean)
189 (fuel-popup--quit)))))
191 (defun fuel-debug--uses-restart (n)
192 (when (and (> n 0) (<= n (length fuel-debug--uses-restarts)))
193 (let* ((inhibit-read-only t)
194 (restart (format ":%s" (cadr (nth (1- n) fuel-debug--uses-restarts))))
195 (cmd `(:fuel ([ (:factor ,restart) ] fuel-with-autouse) t t)))
196 (setq fuel-debug--uses-restarts nil)
197 (insert "\nAsking Factor. Please, wait ...\n")
198 (fuel-eval--send cmd 'fuel-debug--uses-cont))))
203 (defvar fuel-debug-uses-mode-map
204 (let ((map (make-keymap)))
205 (suppress-keymap map)
207 (define-key map (vector (+ ?1 n))
208 `(lambda () (interactive) (fuel-debug--uses-restart ,(1+ n)))))
209 (define-key map "y" 'fuel-debug--uses-update-usings)
210 (define-key map "\C-c\C-c" 'fuel-debug--uses-update-usings)
213 (defun fuel-debug-uses-mode ()
214 "A major mode for displaying Factor's USING: inference results."
216 (kill-all-local-variables)
217 (buffer-disable-undo)
218 (setq major-mode 'fuel-debug-uses-mode)
219 (setq mode-name "Fuel Uses:")
220 (use-local-map fuel-debug-uses-mode-map))
223 (provide 'fuel-debug-uses)
224 ;;; fuel-debug-uses.el ends here