-;;; fuel-debug-uses.el -- retrieving USING: stanzas
+;;; fuel-debug-uses.el -- retrieving USING: stanzas -*- lexical-binding: t -*-
-;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
+;; Copyright (C) 2008, 2009 Jose Antonio Ortega Ruiz
;; See http://factorcode.org/license.txt for BSD license.
;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
(require 'fuel-debug)
(require 'fuel-eval)
(require 'fuel-popup)
-(require 'fuel-font-lock)
(require 'fuel-base)
\f
;;; Customization:
-(fuel-font-lock--defface fuel-font-lock-debug-missing-vocab
- 'font-lock-warning-face fuel-debug "missing vocabulary names")
+;;;###autoload
+(defgroup fuel-debug-uses nil
+ "Customization for FUEL's debug uses."
+ :group 'fuel)
-(fuel-font-lock--defface fuel-font-lock-debug-unneeded-vocab
- 'font-lock-warning-face fuel-debug "unneeded vocabulary names")
+(defface fuel-debug-uses-header-face '((t (:inherit header)))
+ "Header face for FUEL's debug uses."
+ :group 'fuel-debug-uses
+ :group 'fuel-faces
+ :group 'faces)
-(fuel-font-lock--defface fuel-font-lock-debug-uses-header
- 'bold fuel-debug "headers in Uses buffers")
-
-(fuel-font-lock--defface fuel-font-lock-debug-uses-prompt
- 'italic fuel-debug "prompts in Uses buffers")
+(defface fuel-debug-uses-prompt-face '((t (:inherit comint-highlight-prompt)))
+ "Prompt face for FUEL's debug uses."
+ :group 'fuel-debug-uses
+ :group 'fuel-faces
+ :group 'faces)
\f
;;; Utility functions:
+(defsubst fuel-debug--chomp (s)
+ (replace-regexp-in-string "[\n\r\f]" "" s))
+
(defun fuel-debug--file-lines (file)
(when (file-readable-p file)
(with-current-buffer (find-file-noselect file)
(let ((lines) (in-usings))
(while (not (eobp))
(when (looking-at "^USING: ") (setq in-usings t))
- (let ((line (substring-no-properties (thing-at-point 'line) 0 -1)))
+ (let ((line (fuel-debug--chomp
+ (substring-no-properties (thing-at-point 'line)))))
(when in-usings (setq line (concat "! " line)))
(push line lines))
- (when (and in-usings (looking-at ".*\\_<;\\_>")) (setq in-usings nil))
+ (when (and in-usings (looking-at "\\(^\\|.* \\);\\( \\|\n\\)"))
+ (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) 'font-lock-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: "))
- (let ((start (point)))
- (insert (mapconcat 'substring-no-properties uses " ") " ;")
- (fill-region start (point) nil)))
-
(defun fuel-debug--uses-filter (restarts)
(let ((result) (i 1) (rn 0))
(dolist (r restarts (reverse result))
\f
;;; Retrieving USINGs:
-(fuel-popup--define fuel-debug--uses-buffer
- "*fuel uses*" 'fuel-debug-uses-mode)
+(defun fuel-debug--uses-buffer ()
+ (or (get-buffer "*fuel uses*")
+ (with-current-buffer (get-buffer-create "*fuel uses*")
+ (fuel-debug-uses-mode)
+ (fuel-popup-mode)
+ (current-buffer))))
-(make-variable-buffer-local
- (defvar fuel-debug--uses nil))
+(defvar-local fuel-debug--uses-file nil)
-(make-variable-buffer-local
- (defvar fuel-debug--uses-file nil))
-
-(make-variable-buffer-local
- (defvar fuel-debug--uses-restarts nil))
+(defvar-local fuel-debug--uses-restarts nil)
(defsubst fuel-debug--uses-insert-title ()
- (insert "Infering USING: stanza for " fuel-debug--uses-file ".\n\n"))
+ (insert "Inferring 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)))
+ (with-current-buffer (fuel-debug--uses-buffer)
+ (let ((inhibit-read-only t))
+ (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--current-usings (file)
+ (with-current-buffer (find-file-noselect file)
+ (sort (factor-find-usings t) 'string<)))
+
(defun fuel-debug--uses-for-file (file)
(let* ((lines (fuel-debug--file-lines file))
- (cmd `(:fuel ((V{ ,@lines } fuel-get-uses)) t t)))
+ (old-usings (fuel-debug--current-usings file))
+ (cmd `(:fuel ((V{ ,@old-usings }
+ [ ,file V{ ,@lines } fuel-get-uses ]
+ fuel-use-suggested-vocabs)) 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))
+ (with-current-buffer (fuel-debug--uses-buffer)
+ (let ((inhibit-read-only t))
+ (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))
+ (let ((uses (fuel-debug--uses 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)))
+ (if err
+ (fuel-debug--uses-display-err retort)
+ (fuel-debug--uses-display uses))))
(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<))
+ (old (fuel-debug--current-usings fuel-debug--uses-file))
(new (sort uses 'string<)))
(erase-buffer)
(fuel-debug--uses-insert-title)
- (if (equalp old new)
+ (if (cl-equalp old new)
(progn
(insert "Current USING: is already fine!. Type 'q' to bury buffer.\n")
(fuel-debug--uses-clean))
(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))))))))
+ (insert (format " :%s %s\n" (cl-first r) (cl-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 "\nDone!")
- (fuel-debug--uses-clean)
- (bury-buffer)))))
+ (let ((inhibit-read-only t)
+ (file fuel-debug--uses-file)
+ (uses fuel-debug--uses))
+ (when file
+ (insert "\nDone!")
+ (fuel-debug--uses-clean)
+ (fuel-popup--quit)
+ (fuel-debug--replace-usings file uses)
+ (message "USING: updated!"))))
(defun fuel-debug--uses-restart (n)
(when (and (> n 0) (<= n (length fuel-debug--uses-restarts)))
\f
;;; Fuel uses mode:
+(defconst fuel-debug--uses-header-regex
+ (format "^%s.*$"
+ (regexp-opt '("Inferring USING: stanza for "
+ "Current USING: is already fine!"
+ "Current vocabulary list:"
+ "Correct vocabulary list:"
+ "Sorry, couldn't infer the vocabulary list."
+ "Done!"))))
+
+(defconst fuel-debug--uses-prompt-regex
+ (format "^%s"
+ (regexp-opt '("Asking Factor. Please, wait ..."
+ "Please, type the number of the desired vocabulary:"
+ "Type 'y' to update your USING: to the new one."))))
+
+(defconst fuel-debug--uses-font-lock-keywords
+ `((,fuel-debug--uses-header-regex . 'fuel-debug-uses-header-face)
+ (,fuel-debug--uses-prompt-regex . 'fuel-debug-uses-prompt-face)
+ (,fuel-debug--restart-regex (1 'fuel-font-lock-debug-restart-number)
+ (2 'fuel-font-lock-debug-restart-name))))
+
(defvar fuel-debug-uses-mode-map
(let ((map (make-keymap)))
(suppress-keymap map)
(define-key map "\C-c\C-c" 'fuel-debug--uses-update-usings)
map))
-(defconst fuel-debug--uses-header-regex
- (format "^%s.*$" (regexp-opt '("Infering USING: stanza for "
- "Current USING: is already fine!"
- "Current vocabulary list:"
- "Correct vocabulary list:"
- "Sorry, couldn't infer the vocabulary list."
- "Done!"))))
-
-(defconst fuel-debug--uses-prompt-regex
- (format "^%s" (regexp-opt '("Asking Factor. Please, wait ..."
- "Please, type the number of the desired vocabulary:"
- "Type 'y' to update your USING: to the new one."))))
-
-(defconst fuel-debug--uses-font-lock-keywords
- `((,fuel-debug--uses-header-regex . 'fuel-font-lock-debug-uses-header)
- (,fuel-debug--uses-prompt-regex . 'fuel-font-lock-debug-uses-prompt)
- (,fuel-debug--restart-regex (1 'fuel-font-lock-debug-restart-number)
- (2 'fuel-font-lock-debug-restart-name))))
-
-(defun fuel-debug-uses-mode ()
- "A major mode for displaying Factor's USING: inference results."
- (interactive)
- (kill-all-local-variables)
+;;;###autoload
+(define-derived-mode fuel-debug-uses-mode fundamental-mode "FUEL Uses"
+ "A major mode for displaying Factor's USING: inference results.
+\\{fuel-debug-uses-mode-map}"
(buffer-disable-undo)
- (setq major-mode 'fuel-debug-uses-mode)
- (setq mode-name "Fuel Uses:")
- (set (make-local-variable 'font-lock-defaults)
- '(fuel-debug--uses-font-lock-keywords t nil nil nil))
- (use-local-map fuel-debug-uses-mode-map))
+ (setq font-lock-defaults
+ '(fuel-debug--uses-font-lock-keywords t nil nil nil)))
\f
(provide 'fuel-debug-uses)
+
;;; fuel-debug-uses.el ends here
projects / factor.git / blobdiff