/misc/fuel/fuel-debug-uses.el

  1;;; fuel-debug-uses.el -- retrieving USING: stanzas
  2
  3;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
  4;; See http://factorcode.org/license.txt for BSD license.
  5
  6;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
  7;; Keywords: languages, fuel, factor
  8;; Start date: Tue Dec 23, 2008 04:23
  9
 10;;; Comentary:
 11
 12;; Support for getting and updating factor source vocabulary lists.
 13
 14;;; Code:
 15
 16(require 'fuel-debug)
 17(require 'fuel-eval)
 18(require 'fuel-popup)
 19(require 'fuel-font-lock)
 20(require 'fuel-base)
 21
 22
 23
 24;;; Customization:
 25
 26(fuel-font-lock--defface fuel-font-lock-debug-uses-header
 27  'bold fuel-debug "headers in Uses buffers")
 28
 29(fuel-font-lock--defface fuel-font-lock-debug-uses-prompt
 30  'italic fuel-debug "prompts in Uses buffers")
 31
 32
 33;;; Utility functions:
 34
 35(defsubst fuel-debug--chomp (s)
 36  (replace-regexp-in-string "[\n\r\f]" "" s))
 37
 38(defun fuel-debug--file-lines (file)
 39  (when (file-readable-p file)
 40    (with-current-buffer (find-file-noselect file)
 41      (save-excursion
 42        (goto-char (point-min))
 43        (let ((lines) (in-usings))
 44          (while (not (eobp))
 45            (when (looking-at "^USING: ") (setq in-usings t))
 46            (let ((line (fuel-debug--chomp
 47                         (substring-no-properties (thing-at-point 'line)))))
 48              (when in-usings (setq line (concat "! " line)))
 49              (push line lines))
 50            (when (and in-usings (looking-at "\\(^\\|.* \\);\\( \\|\n\\)"))
 51              (setq in-usings nil))
 52            (forward-line))
 53          (reverse lines))))))
 54
 55(defun fuel-debug--uses-filter (restarts)
 56  (let ((result) (i 1) (rn 0))
 57    (dolist (r restarts (reverse result))
 58      (setq rn (1+ rn))
 59      (when (string-match "Use the .+ vocabulary\\|Defer" r)
 60        (push (list i rn r) result)
 61        (setq i (1+ i))))))
 62
 63
 64;;; Retrieving USINGs:
 65
 66(fuel-popup--define fuel-debug--uses-buffer
 67  "*fuel uses*" 'fuel-debug-uses-mode)
 68
 69(make-variable-buffer-local
 70 (defvar fuel-debug--uses-file nil))
 71
 72(make-variable-buffer-local
 73 (defvar fuel-debug--uses-restarts nil))
 74
 75(defsubst fuel-debug--uses-insert-title ()
 76  (insert "Inferring USING: stanza for " fuel-debug--uses-file ".\n\n"))
 77
 78(defun fuel-debug--uses-prepare (file)
 79  (fuel--with-popup (fuel-debug--uses-buffer)
 80    (setq fuel-debug--uses-file file
 81          fuel-debug--uses nil
 82          fuel-debug--uses-restarts nil)
 83    (erase-buffer)
 84    (fuel-debug--uses-insert-title)))
 85
 86(defun fuel-debug--uses-clean ()
 87  (setq fuel-debug--uses-file nil
 88        fuel-debug--uses nil
 89        fuel-debug--uses-restarts nil))
 90
 91(defun fuel-debug--current-usings (file)
 92  (with-current-buffer (find-file-noselect file)
 93    (sort (fuel-syntax--find-usings t) 'string<)))
 94
 95(defun fuel-debug--uses-for-file (file)
 96  (let* ((lines (fuel-debug--file-lines file))
 97         (old-usings (fuel-debug--current-usings file))
 98         (cmd `(:fuel ((V{ ,@old-usings }
 99                           [ V{ ,@lines } fuel-get-uses ]
100                           fuel-use-suggested-vocabs)) t t)))
101    (fuel-debug--uses-prepare file)
102    (fuel--with-popup (fuel-debug--uses-buffer)
103      (insert "Asking Factor. Please, wait ...\n")
104      (fuel-eval--send cmd 'fuel-debug--uses-cont))
105    (fuel-popup--display (fuel-debug--uses-buffer))))
106
107(defun fuel-debug--uses-cont (retort)
108  (let ((uses (fuel-debug--uses retort))
109        (err (fuel-eval--retort-error retort)))
110    (if uses (fuel-debug--uses-display uses)
111      (fuel-debug--uses-display-err retort))))
112
113(defun fuel-debug--uses-display (uses)
114  (let* ((inhibit-read-only t)
115         (old (fuel-debug--current-usings fuel-debug--uses-file))
116         (new (sort uses 'string<)))
117    (erase-buffer)
118    (fuel-debug--uses-insert-title)
119    (if (equalp old new)
120        (progn
121          (insert "Current USING: is already fine!. Type 'q' to bury buffer.\n")
122          (fuel-debug--uses-clean))
123      (fuel-debug--highlight-names old new 'fuel-font-lock-debug-unneeded-vocab)
124      (fuel-debug--highlight-names new old 'fuel-font-lock-debug-missing-vocab)
125      (fuel-debug--insert-vlist "Current vocabulary list:" old)
126      (newline)
127      (fuel-debug--insert-vlist "Correct vocabulary list:" new)
128      (setq fuel-debug--uses new)
129      (insert "\nType 'y' to update your USING: to the new one.\n"))))
130
131(defun fuel-debug--uses-display-err (retort)
132  (let* ((inhibit-read-only t)
133         (err (fuel-eval--retort-error retort))
134         (restarts (fuel-debug--uses-filter (fuel-eval--error-restarts err)))
135         (unique (= 1 (length restarts))))
136    (erase-buffer)
137    (fuel-debug--uses-insert-title)
138    (insert (fuel-eval--retort-output retort))
139    (newline)
140    (if (not restarts)
141        (insert "\nSorry, couldn't infer the vocabulary list.\n")
142      (setq fuel-debug--uses-restarts restarts)
143      (if unique (fuel-debug--uses-restart 1)
144        (insert "\nPlease, type the number of the desired vocabulary:\n\n")
145        (dolist (r restarts)
146          (insert (format " :%s %s\n" (first r) (third r))))))))
147
148(defun fuel-debug--uses-update-usings ()
149  (interactive)
150  (let ((inhibit-read-only t)
151        (file fuel-debug--uses-file)
152        (uses fuel-debug--uses))
153    (when (and uses file)
154      (insert "\nDone!")
155      (fuel-debug--uses-clean)
156      (fuel-popup--quit)
157      (fuel-debug--replace-usings file uses)
158      (message "USING: updated!"))))
159
160(defun fuel-debug--uses-restart (n)
161  (when (and (> n 0) (<= n (length fuel-debug--uses-restarts)))
162    (let* ((inhibit-read-only t)
163           (restart (format ":%s" (cadr (nth (1- n) fuel-debug--uses-restarts))))
164           (cmd `(:fuel ([ (:factor ,restart) ] fuel-with-autouse) t t)))
165      (setq fuel-debug--uses-restarts nil)
166      (insert "\nAsking Factor. Please, wait ...\n")
167      (fuel-eval--send cmd 'fuel-debug--uses-cont))))
168
169
170;;; Fuel uses mode:
171
172(defvar fuel-debug-uses-mode-map
173  (let ((map (make-keymap)))
174    (suppress-keymap map)
175    (dotimes (n 9)
176      (define-key map (vector (+ ?1 n))
177        `(lambda () (interactive) (fuel-debug--uses-restart ,(1+ n)))))
178    (define-key map "y" 'fuel-debug--uses-update-usings)
179    (define-key map "\C-c\C-c" 'fuel-debug--uses-update-usings)
180    map))
181
182(defconst fuel-debug--uses-header-regex
183  (format "^%s.*$" (regexp-opt '("Inferring USING: stanza for "
184                                 "Current USING: is already fine!"
185                                 "Current vocabulary list:"
186                                 "Correct vocabulary list:"
187                                 "Sorry, couldn't infer the vocabulary list."
188                                 "Done!"))))
189
190(defconst fuel-debug--uses-prompt-regex
191  (format "^%s" (regexp-opt '("Asking Factor. Please, wait ..."
192                              "Please, type the number of the desired vocabulary:"
193                              "Type 'y' to update your USING: to the new one."))))
194
195(defconst fuel-debug--uses-font-lock-keywords
196  `((,fuel-debug--uses-header-regex . 'fuel-font-lock-debug-uses-header)
197    (,fuel-debug--uses-prompt-regex . 'fuel-font-lock-debug-uses-prompt)
198    (,fuel-debug--restart-regex (1 'fuel-font-lock-debug-restart-number)
199                                (2 'fuel-font-lock-debug-restart-name))))
200
201(defun fuel-debug-uses-mode ()
202  "A major mode for displaying Factor's USING: inference results."
203  (interactive)
204  (kill-all-local-variables)
205  (buffer-disable-undo)
206  (setq major-mode 'fuel-debug-uses-mode)
207  (setq mode-name "Fuel Uses:")
208  (set (make-local-variable 'font-lock-defaults)
209       '(fuel-debug--uses-font-lock-keywords t nil nil nil))
210  (use-local-map fuel-debug-uses-mode-map))
211
212
213(provide 'fuel-debug-uses)
214;;; fuel-debug-uses.el ends here