Merge branch 'master' of git://factorcode.org/git/factor

extra/easy-help/easy-help.factor

@@ -1,5 +1,8 @@
 
-USING: kernel multiline parser sequences splitting grouping help.markup ;
+USING: arrays assocs compiler.units 
+       grouping help help.markup help.topics kernel lexer multiline
+       namespaces parser sequences splitting words
+       easy-help.expand-markup ;
 
 IN: easy-help
 
@@ -52,10 +55,57 @@ IN: easy-help
 : Values:
 
   ".." parse-multiline-string
-  " \n" split
+  string-lines
-  [ "" = not ] filter
+  1 tail
-  2 group
+  [ dup "   " head? [ 4 tail ] [ ] if ] map
+  [ " " split1 [ " " first = ] trim-left 2array ] map
   \ $values prefix
   parsed
 
-  ; parsing
+  ; parsing
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: Word:
+
+  scan current-vocab create dup old-definitions get
+  [ delete-at ] with each dup set-word
+
+  bootstrap-word dup set-word
+  dup >link save-location
+  \ ; parse-until >array swap set-word-help ; parsing
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: Contract:
+
+  ".." parse-multiline-string
+  string-lines
+  1 tail
+  [ dup "   " head? [ 4 tail     ] [ ] if ] map
+  [ expand-markup ] map
+  concat
+  [ dup ""    =     [ drop { $nl } ] [ ] if ] map
+  \ $contract prefix
+  parsed
+  
+  ; parsing
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: Notes:
+
+  ".." parse-multiline-string
+  string-lines
+  1 tail
+  [ dup "   " head? [ 4 tail     ] [ ] if ] map
+  [ expand-markup ] map
+  concat
+  [ dup ""    =     [ drop { $nl } ] [ ] if ] map
+  \ $notes prefix
+  parsed
+  
+  ; parsing
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+

extra/easy-help/expand-markup/expand-markup.factor

@@ -0,0 +1,47 @@
+
+USING: accessors arrays kernel lexer locals math namespaces parser
+       sequences splitting ;
+
+IN: easy-help.expand-markup
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: scan-one-array ( string -- array rest )
+  string-lines
+  lexer-factory get call
+  [
+  [
+    \ } parse-until >array
+    lexer get line-text>>
+    lexer get column>> tail
+  ]
+  with-lexer
+  ]
+  with-scope ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: contains-markup? ( string -- ? ) "{ $" swap subseq? ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+:: expand-markup ( LINE -- lines )
+  
+  LINE contains-markup?
+    [
+    
+      [let | N [ "{ $" LINE start ] |
+
+        LINE N head
+
+        LINE N 2 + tail scan-one-array  dup " " head? [ 1 tail ] [ ] if
+
+        [ 2array ] dip
+
+        expand-markup
+
+        append ]
+        
+    ]
+    [ LINE 1array ]
+  if ;

extra/fuel/fuel.factor

@@ -1,13 +1,11 @@
 ! Copyright (C) 2008 Jose Antonio Ortega Ruiz.
 ! See http://factorcode.org/license.txt for BSD license.
 
-USING: accessors arrays assocs classes classes.tuple
+USING: accessors arrays assocs classes.tuple combinators
-combinators compiler.units continuations debugger definitions
+compiler.units continuations debugger definitions io io.pathnames
-eval help io io.files io.pathnames io.streams.string kernel
+io.streams.string kernel lexer math math.order memoize namespaces
-lexer listener listener.private make math math.order memoize
+parser prettyprint sequences sets sorting source-files strings summary
-namespaces parser prettyprint prettyprint.config quotations
+tools.vocabs vectors vocabs vocabs.parser words ;
-sequences sets sorting source-files strings summary tools.vocabs
-vectors vocabs vocabs.loader vocabs.parser words ;
 
 IN: fuel
 
@@ -138,8 +136,23 @@ M: source-file fuel-pprint path>> fuel-pprint ;
     [ (fuel-eval-usings) (fuel-eval-in) (fuel-eval) ] with-string-writer
     (fuel-end-eval) ;
 
+! Loading files
+
 : fuel-run-file ( path -- ) run-file ; inline
 
+: fuel-with-autouse ( quot -- )
+    [
+        auto-use? on
+        [ amended-use get clone fuel-eval-set-result ] print-use-hook set
+        call
+    ] curry with-scope ;
+
+: (fuel-get-uses) ( lines -- )
+    [ parse-fresh drop ] curry with-compilation-unit ; inline
+
+: fuel-get-uses ( lines -- )
+    [ (fuel-get-uses) ] curry fuel-with-autouse ;
+
 ! Edit locations
 
 : fuel-normalize-loc ( seq -- path line )

extra/size-of/size-of.factor

@@ -8,11 +8,13 @@ IN: size-of
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-DEFER: size-of
+Word: size-of
 
-HELP: size-of
+Values:
 
-Values: HEADERS sequence  TYPE string  n integer ..
+    HEADERS sequence : List of header files
+    TYPE    string : A C type
+    n       integer : Size in number of bytes ..
 
 Description:
 
@@ -57,4 +59,3 @@ Example:
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
- 

misc/fuel/README

@@ -57,6 +57,7 @@ C-cC-eC-r is the same as C-cC-er)).
 
  - M-. : edit word at point in Emacs
  - M-TAB : complete word at point
+ - C-cC-eu : update USING: line
  - C-cC-ev : edit vocabulary (M-x fuel-edit-vocabulary)
  - C-cC-ew : edit word (M-x fuel-edit-word-at-point)
  - C-cC-ed : edit word's doc (M-x fuel-edit-word-at-point)

misc/fuel/fuel-base.el

@@ -87,7 +87,7 @@
 
 (defun fuel--string-prefix-p (prefix str)
   (and (>= (length str) (length prefix))
-       (string= (substring-no-properties 0 (length prefix) str)
+       (string= (substring-no-properties str 0 (length prefix))
                 (substring-no-properties prefix))))
 
 (defun fuel--respecting-message (format &rest format-args)

misc/fuel/fuel-connection.el

@@ -235,7 +235,7 @@
                         (not (fuel-con--connection-completed-p con id)))
               (accept-process-output nil waitsecs)
               (setq time (- time step)))
-          (error (setq time 1)))
+          (error (setq time 0)))
         (or (> time 0)
             (fuel-con--request-deactivate req)
             nil)))))

misc/fuel/fuel-debug-uses.el

@@ -0,0 +1,224 @@
+;;; fuel-debug-uses.el -- retrieving USING: stanzas
+
+;; Copyright (C) 2008 Jose Antonio Ortega Ruiz
+;; See http://factorcode.org/license.txt for BSD license.
+
+;; Author: Jose Antonio Ortega Ruiz <jao@gnu.org>
+;; Keywords: languages, fuel, factor
+;; Start date: Tue Dec 23, 2008 04:23
+
+;;; Comentary:
+
+;; Support for getting and updating factor source vocabulary lists.
+
+;;; Code:
+
+(require 'fuel-debug)
+(require 'fuel-eval)
+(require 'fuel-popup)
+(require 'fuel-font-lock)
+(require 'fuel-base)
+
+
+
+;;; Customization:
+
+(fuel-font-lock--defface fuel-font-lock-debug-missing-vocab
+  'font-lock-warning-face fuel-debug "missing vocabulary names")
+
+(fuel-font-lock--defface fuel-font-lock-debug-unneeded-vocab
+  'font-lock-warning-face fuel-debug "unneeded vocabulary names")
+
+(fuel-font-lock--defface fuel-font-lock-debug-uses-header
+  'bold fuel-debug "headers in Uses buffers")
+
+
+;;; Utility functions:
+
+(defsubst fuel-debug--at-eou-p ()
+  (looking-at ".*\\_<;\\_>"))
+
+(defun fuel-debug--file-lines (file)
+  (when (file-readable-p file)
+    (with-current-buffer (find-file-noselect file)
+      (save-excursion
+        (goto-char (point-min))
+        (let ((lines) (in-usings))
+          (while (not (eobp))
+            (when (looking-at "^USING: ") (setq in-usings t))
+            (unless in-usings
+              (let ((line (substring-no-properties (thing-at-point 'line) 0 -1)))
+                (unless (or (empty-string-p line)
+                            (fuel--string-prefix-p "! " line))
+                  (push line lines))))
+            (when (and in-usings (fuel-debug--at-eou-p)) (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) '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 'identity uses " ") " ;")
+    (fill-region start (point) nil)))
+
+(defun fuel-debug--uses-filter (restarts)
+  (let ((result) (i 1) (rn 0))
+    (dolist (r restarts (reverse result))
+      (setq rn (1+ rn))
+      (when (string-match "Use the .+ vocabulary\\|Defer" r)
+        (push (list i rn r) result)
+        (setq i (1+ i))))))
+
+
+;;; Retrieving USINGs:
+
+(fuel-popup--define fuel-debug--uses-buffer
+  "*fuel uses*" 'fuel-debug-uses-mode)
+
+(make-variable-buffer-local
+ (defvar fuel-debug--uses nil))
+
+(make-variable-buffer-local
+ (defvar fuel-debug--uses-file nil))
+
+(make-variable-buffer-local
+ (defvar fuel-debug--uses-restarts nil))
+
+(defsubst fuel-debug--uses-insert-title ()
+  (insert "Infering 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)))
+
+(defun fuel-debug--uses-clean ()
+  (setq fuel-debug--uses-file nil
+        fuel-debug--uses nil
+        fuel-debug--uses-restarts nil))
+
+(defun fuel-debug--uses-for-file (file)
+  (let* ((lines (fuel-debug--file-lines file))
+         (cmd `(:fuel ((V{ ,@lines } fuel-get-uses)) 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))
+    (fuel-popup--display (fuel-debug--uses-buffer))))
+
+(defun fuel-debug--uses-cont (retort)
+  (let ((uses (fuel-eval--retort-result 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)))
+
+(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<))
+         (new (sort uses 'string<)))
+    (erase-buffer)
+    (fuel-debug--uses-insert-title)
+    (if (equalp old new)
+        (progn
+          (insert "Current USING: is already fine!. Type 'q' to bury buffer.\n")
+          (fuel-debug--uses-clean))
+      (fuel-debug--highlight-names old new 'fuel-font-lock-debug-unneeded-vocab)
+      (fuel-debug--highlight-names new old 'fuel-font-lock-debug-missing-vocab)
+      (fuel-debug--insert-vlist "Current vocabulary list:" old)
+      (newline)
+      (fuel-debug--insert-vlist "Correct vocabulary list:" new)
+      (setq fuel-debug--uses new)
+      (insert "\nType 'y' to update your USING: to the new one.\n"))))
+
+(defun fuel-debug--uses-display-err (retort)
+  (let* ((inhibit-read-only t)
+         (err (fuel-eval--retort-error retort))
+         (restarts (fuel-debug--uses-filter (fuel-eval--error-restarts err)))
+         (unique (= 1 (length restarts))))
+    (erase-buffer)
+    (fuel-debug--uses-insert-title)
+    (insert (fuel-eval--retort-output retort))
+    (newline)
+    (if (not restarts)
+        (insert "\nSorry, couldn't infer the vocabulary list.\n")
+      (setq fuel-debug--uses-restarts restarts)
+      (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))))))))
+
+(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 "\n Done!")
+        (fuel-debug--uses-clean)
+        (fuel-popup--quit)))))
+
+(defun fuel-debug--uses-restart (n)
+  (when (and (> n 0) (<= n (length fuel-debug--uses-restarts)))
+    (let* ((inhibit-read-only t)
+           (restart (format ":%s" (cadr (nth (1- n) fuel-debug--uses-restarts))))
+           (cmd `(:fuel ([ (:factor ,restart) ] fuel-with-autouse) t t)))
+      (setq fuel-debug--uses-restarts nil)
+      (insert "\nAsking Factor. Please, wait ...\n")
+      (fuel-eval--send cmd 'fuel-debug--uses-cont))))
+
+
+;;; Fuel uses mode:
+
+(defvar fuel-debug-uses-mode-map
+  (let ((map (make-keymap)))
+    (suppress-keymap map)
+    (dotimes (n 9)
+      (define-key map (vector (+ ?1 n))
+        `(lambda () (interactive) (fuel-debug--uses-restart ,(1+ n)))))
+    (define-key map "y" 'fuel-debug--uses-update-usings)
+    (define-key map "\C-c\C-c" 'fuel-debug--uses-update-usings)
+    map))
+
+(defun fuel-debug-uses-mode ()
+  "A major mode for displaying Factor's USING: inference results."
+  (interactive)
+  (kill-all-local-variables)
+  (buffer-disable-undo)
+  (setq major-mode 'fuel-debug-uses-mode)
+  (setq mode-name "Fuel Uses:")
+  (use-local-map fuel-debug-uses-mode-map))
+
+
+(provide 'fuel-debug-uses)
+;;; fuel-debug-uses.el ends here

misc/fuel/fuel-debug.el

@@ -92,7 +92,14 @@
 (make-variable-buffer-local
  (defvar fuel-debug--file nil))
 
-(defun fuel-debug--display-retort (ret &optional success-msg no-pop file)
+(defun fuel-debug--prepare-compilation (file msg)
+  (let ((inhibit-read-only t))
+    (with-current-buffer (fuel-debug--buffer)
+      (erase-buffer)
+      (insert msg)
+      (setq fuel-debug--file file))))
+
+(defun fuel-debug--display-retort (ret &optional success-msg no-pop)
   (let ((err (fuel-eval--retort-error ret))
         (inhibit-read-only t))
     (with-current-buffer (fuel-debug--buffer)
@@ -107,12 +114,11 @@
         (fuel-debug--display-restarts err)
         (delete-blank-lines)
         (newline))
-      (let ((hstr (fuel-debug--help-string err file)))
+      (let ((hstr (fuel-debug--help-string err fuel-debug--file)))
         (if fuel-debug-show-short-help
             (insert "-----------\n" hstr "\n")
           (message "%s" hstr)))
       (setq fuel-debug--last-ret ret)
-      (setq fuel-debug--file file)
       (goto-char (point-max))
       (font-lock-fontify-buffer)
       (when (and err (not no-pop)) (fuel-popup--display))
@@ -219,11 +225,8 @@
     (unless (re-search-forward (format "^%s" info) nil t)
       (error "%s information not available" info))
     (message "Retrieving %s info ..." info)
-    (unless (fuel-debug--display-retort (fuel-eval--send/wait
+    (unless (fuel-debug--display-retort
-                                         `(:fuel ((:factor ,info))))
+             (fuel-eval--send/wait `(:fuel ((:factor ,info)))) "")
-                                        ""
-                                        nil
-                                        (fuel-debug--buffer-file))
       (error "Sorry, no %s info available" info))))
 
 
@@ -236,7 +239,6 @@
     (define-key map "\C-c\C-c" 'fuel-debug-goto-error)
     (define-key map "n" 'next-line)
     (define-key map "p" 'previous-line)
-    (define-key map "q" 'bury-buffer)
     (dotimes (n 9)
       (define-key map (vector (+ ?1 n))
         `(lambda () (interactive) (fuel-debug-exec-restart ,(1+ n) t))))
@@ -252,15 +254,15 @@ invoking restarts as needed.
   (interactive)
   (kill-all-local-variables)
   (buffer-disable-undo)
-  (setq major-mode 'factor-mode)
+  (setq major-mode 'fuel-debug-mode)
   (setq mode-name "Fuel Debug")
   (use-local-map fuel-debug-mode-map)
   (fuel-debug--font-lock-setup)
   (setq fuel-debug--file nil)
   (setq fuel-debug--last-ret nil)
-  (setq buffer-read-only t)
   (run-hooks 'fuel-debug-mode-hook))
 
+
 
 (provide 'fuel-debug)
 ;;; fuel-debug.el ends here

misc/fuel/fuel-eval.el

@@ -130,14 +130,15 @@
 
 (defsubst fuel-eval--error-name (err) (car err))
 
-(defsubst fuel-eval--error-restarts (err)
-  (cdr (assoc :restarts (fuel-eval--error-name-p err 'condition))))
-
 (defun fuel-eval--error-name-p (err name)
   (unless (null err)
     (or (and (eq (fuel-eval--error-name err) name) err)
         (assoc name err))))
 
+(defsubst fuel-eval--error-restarts (err)
+  (cdr (assoc :restarts (or (fuel-eval--error-name-p err 'condition)
+                            (fuel-eval--error-name-p err 'lexer-error)))))
+
 (defsubst fuel-eval--error-file (err)
   (nth 1 (fuel-eval--error-name-p err 'source-file-error)))
 

misc/fuel/fuel-font-lock.el

@@ -68,16 +68,11 @@
 
 ;;; Font lock:
 
-(defconst fuel-font-lock--parsing-lock-keywords
-  (cons '("\\(P\\|SBUF\\)\"" 1 'factor-font-lock-parsing-word)
-        (mapcar (lambda (w) `(,(format "\\(^\\| \\)\\(%s\\)\\($\\| \\)" w)
-                         2 'factor-font-lock-parsing-word))
-                fuel-syntax--parsing-words)))
-
 (defconst fuel-font-lock--font-lock-keywords
-  `(,@fuel-font-lock--parsing-lock-keywords
+  `((,fuel-syntax--parsing-words-regex . 'factor-font-lock-parsing-word)
+    (,fuel-syntax--brace-words-regex 1 'factor-font-lock-parsing-word)
+    ("\\(P\\|SBUF\\)\"" 1 'factor-font-lock-parsing-word)
     (,fuel-syntax--stack-effect-regex . 'factor-font-lock-stack-effect)
-    (,fuel-syntax--parsing-words-ext-regex . 'factor-font-lock-parsing-word)
     (,fuel-syntax--declaration-words-regex . 'factor-font-lock-declaration)
     (,fuel-syntax--word-definition-regex 2 'factor-font-lock-word)
     (,fuel-syntax--type-definition-regex 2 'factor-font-lock-type-name)

misc/fuel/fuel-listener.el

@@ -105,6 +105,7 @@ buffer."
 
 (defun fuel-listener-nuke ()
   (interactive)
+  (comint-redirect-cleanup)
   (fuel-con--setup-connection fuel-listener--buffer))
 
 

misc/fuel/fuel-mode.el

@@ -17,6 +17,7 @@
 (require 'fuel-listener)
 (require 'fuel-completion)
 (require 'fuel-debug)
+(require 'fuel-debug-uses)
 (require 'fuel-eval)
 (require 'fuel-help)
 (require 'fuel-xref)
@@ -68,15 +69,14 @@ With prefix argument, ask for the file to run."
          (buffer (cdr f/b)))
     (when buffer
       (with-current-buffer buffer
-        (message "Compiling %s ..." file)
+        (let ((msg (format "Compiling %s ..." file)))
-        (fuel-eval--send `(:fuel (,file fuel-run-file))
+          (fuel-debug--prepare-compilation file msg)
-                         `(lambda (r) (fuel--run-file-cont r ,file)))))))
+          (message msg)
+          (fuel-eval--send `(:fuel (,file fuel-run-file))
+                           `(lambda (r) (fuel--run-file-cont r ,file))))))))
 
 (defun fuel--run-file-cont (ret file)
-  (if (fuel-debug--display-retort ret
+  (if (fuel-debug--display-retort ret (format "%s successfully compiled" file))
-                                  (format "%s successfully compiled" file)
-                                  nil
-                                  file)
       (message "Compiling %s ... OK!" file)
     (message "")))
 
@@ -86,17 +86,20 @@ With prefix argument, ask for the file to run."
 Unless called with a prefix, switches to the compilation results
 buffer in case of errors."
   (interactive "r\nP")
-  (let* ((lines (split-string (buffer-substring-no-properties begin end)
+  (let* ((rstr (buffer-substring begin end))
-                              "[\f\n\r\v]+" t))
+         (lines (split-string (substring-no-properties rstr)
+                              "[\f\n\r\v]+"
+                              t))
          (cmd `(:fuel (,(mapcar (lambda (l) `(:factor ,l)) lines))))
          (cv (fuel-syntax--current-vocab)))
+    (fuel-debug--prepare-compilation (buffer-file-name)
+                                     (format "Evaluating:\n\n%s" rstr))
     (fuel-debug--display-retort
      (fuel-eval--send/wait cmd 10000)
      (format "%s%s"
              (if cv (format "IN: %s " cv) "")
              (fuel--shorten-region begin end 70))
-     arg
+     arg)))
-     (buffer-file-name))))
 
 (defun fuel-eval-extended-region (begin end &optional arg)
   "Sends region, extended outwards to nearest definition,
@@ -120,6 +123,14 @@ buffer in case of errors."
       (unless (< begin end) (error "No evaluable definition around point"))
       (fuel-eval-region begin end arg))))
 
+(defun fuel-update-usings (&optional arg)
+  "Asks factor for the vocabularies needed by this file,
+optionally updating the its USING: line.
+With prefix argument, ask for the file name."
+  (interactive "P")
+  (let ((file (car (fuel-mode--read-file arg))))
+    (when file (fuel-debug--uses-for-file file))))
+
 (defun fuel--try-edit (ret)
   (let* ((err (fuel-eval--retort-error ret))
          (loc (fuel-eval--retort-result ret)))
@@ -270,6 +281,7 @@ interacting with a factor listener is at your disposal.
 (fuel-mode--key ?e ?e 'fuel-eval-extended-region)
 (fuel-mode--key ?e ?l 'fuel-run-file)
 (fuel-mode--key ?e ?r 'fuel-eval-region)
+(fuel-mode--key ?e ?u 'fuel-update-usings)
 (fuel-mode--key ?e ?v 'fuel-edit-vocabulary)
 (fuel-mode--key ?e ?w 'fuel-edit-word)
 (fuel-mode--key ?e ?x 'fuel-eval-definition)

misc/fuel/fuel-popup.el

@@ -44,7 +44,8 @@
 (define-minor-mode fuel-popup-mode
   "Mode for displaying read only stuff"
   nil nil
-  '(("q" . fuel-popup--quit)))
+  '(("q" . fuel-popup--quit))
+  (setq buffer-read-only t))
 
 (defmacro fuel-popup--define (fun name mode)
   `(defun ,fun ()
@@ -55,6 +56,14 @@
            (current-buffer)))))
 
 (put 'fuel-popup--define 'lisp-indent-function 1)
+
+(defmacro fuel--with-popup (buffer &rest body)
+  `(with-current-buffer ,buffer
+     (let ((inhibit-read-only t))
+       ,@body)))
+
+(put 'fuel--with-popup 'lisp-indent-function 1)
+
 
 (provide 'fuel-popup)
 ;;; fuel-popup.el ends here

misc/fuel/fuel-syntax.el

@@ -43,20 +43,26 @@
 ;;; Regexps galore:
 
 (defconst fuel-syntax--parsing-words
-  '("{" "}" "^:" "^::" ";" "<<" "<PRIVATE" ">>"
+  '(":" "::" ";" "<<" "<PRIVATE" ">>"
-    "BIN:" "BV{" "B{" "C:" "C-STRUCT:" "C-UNION:" "CHAR:" "CS{" "C{"
+    "B" "BIN:" "C:" "C-STRUCT:" "C-UNION:" "CHAR:"
     "DEFER:" "ERROR:" "EXCLUDE:" "FORGET:"
-    "GENERIC#" "GENERIC:" "HEX:" "HOOK:" "H{"
+    "GENERIC#" "GENERIC:" "HEX:" "HOOK:"
     "IN:" "INSTANCE:" "INTERSECTION:"
     "M:" "MACRO:" "MACRO::" "MAIN:" "MATH:" "MEMO:" "METHOD:" "MIXIN:"
     "OCT:" "POSTPONE:" "PREDICATE:" "PRIMITIVE:" "PRIVATE>" "PROVIDE:"
     "REQUIRE:"  "REQUIRES:" "SINGLETON:" "SLOT:" "SYMBOL:" "SYMBOLS:"
-    "TUPLE:" "T{" "t\\??" "TYPEDEF:"
+    "TUPLE:" "t" "t?" "TYPEDEF:"
-    "UNION:" "USE:" "USING:" "V{" "VARS:" "W{"))
+    "UNION:" "USE:" "USING:" "VARS:"
+    "call-next-method" "delimiter" "f" "initial:" "read-only"))
 
-(defconst fuel-syntax--parsing-words-ext-regex
+(defconst fuel-syntax--bracers
-  (regexp-opt '("B" "call-next-method" "delimiter" "f" "initial:" "read-only")
+  '("B" "BV" "C" "CS" "H" "T" "V" "W"))
-              'words))
+
+(defconst fuel-syntax--parsing-words-regex
+  (regexp-opt fuel-syntax--parsing-words 'words))
+
+(defconst fuel-syntax--brace-words-regex
+  (format "%s{" (regexp-opt fuel-syntax--bracers t)))
 
 (defconst fuel-syntax--declaration-words
   '("flushable" "foldable" "inline" "parsing" "recursive"))
@@ -132,43 +138,40 @@
 
 ;;; Factor syntax table
 
-(defvar fuel-syntax--syntax-table
+(setq fuel-syntax--syntax-table
   (let ((table (make-syntax-table)))
     ;; Default is word constituent
     (dotimes (i 256)
       (modify-syntax-entry i "w" table))
 
-    ;; Whitespace
+    ;; Whitespace (TAB is not whitespace)
-    (modify-syntax-entry ?\t " " table)
     (modify-syntax-entry ?\f " " table)
     (modify-syntax-entry ?\r " " table)
     (modify-syntax-entry ?\  " " table)
     (modify-syntax-entry ?\n " " table)
 
-    ;; Parenthesis
-    (modify-syntax-entry ?\[ "(]" table)
-    (modify-syntax-entry ?\] ")[" table)
-    (modify-syntax-entry ?{ "(}" table)
-    (modify-syntax-entry ?} "){" table)
-
-    (modify-syntax-entry ?\( "()" table)
-    (modify-syntax-entry ?\) ")(" table)
-
     ;; Strings
     (modify-syntax-entry ?\" "\"" table)
     (modify-syntax-entry ?\\ "/" table)
+
     table))
 
 (defconst fuel-syntax--syntactic-keywords
-  `(("\\(#!\\) .*\\(\n\\)" (1 "<") (2 ">"))
+  `(("\\_<\\(#?!\\) .*\\(\n\\)" (1 "<") (2 ">"))
-    ("\\( \\|^\\)\\(!\\) .*\\(\n\\)" (2 "<") (3 ">"))
+    ("\\_<\\(#?!\\)\\(\n\\)" (1 "<") (2 ">"))
-    ("\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
+    ("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))
     ("\\(\\[\\)\\(let\\|wlet\\|let\\*\\)\\( \\|$\\)" (1 "(]"))
     ("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|"))
     (" \\(|\\) " (1 "(|"))
     (" \\(|\\)$" (1 ")"))
-    ("\\([[({]\\)\\([^ \"\n]\\)" (1 "_") (2 "_"))
+    ("CHAR: \\(\"\\)\\( \\|$\\)" (1 "w"))
-    ("\\([^ \"\n]\\)\\([])}]\\)" (1 "_") (2 "_"))))
+    (,(format "\\_<%s\\({\\)\\_>" (regexp-opt fuel-syntax--bracers)) (1 "(}"))
+    ("\\_<\\({\\)\\_>" (1 "(}"))
+    ("\\_<\\(}\\)\\_>" (1 "){"))
+    ("\\_<\\((\\)\\_>" (1 "()"))
+    ("\\_<\\()\\)\\_>" (1 ")("))
+    ("\\_<\\(\\[\\)\\_>" (1 "(]"))
+    ("\\_<\\(\\]\\)\\_>" (1 ")["))))
 
 
 ;;; Source code analysis: