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 \f
  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 \f
  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 \f
  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 \f
 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 \f
 213 (provide 'fuel-debug-uses)
 214 ;;; fuel-debug-uses.el ends here