Merge branch 'emacs' of http://git.hacks-galore.org/jao/factor

extra/bubble-chamber/bubble-chamber.factor

@@ -524,6 +524,24 @@ M:: <bubble-chamber> update-frame-buffer ( BUBBLE-CHAMBER -- )
     
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
+: hadron-chamber ( -- )
+  bubble-chamber-window
+  1000 [ hadron add-particle ] times
+  big-bang
+  drop ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Experimental
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
+: muon-chamber ( -- )
+  bubble-chamber-window
+  1000 [ muon add-particle ] times
+  dup particles>> [ collide randomize-collision-theta ] each
+  drop ;
+
+! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+
 : original-big-bang ( -- )
   bubble-chamber
     { 1000 1000 } >>size
@@ -541,22 +559,6 @@ M:: <bubble-chamber> update-frame-buffer ( BUBBLE-CHAMBER -- )
 
 ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 
-: hadron-chamber ( -- )
-  bubble-chamber-window
-  1000 [ hadron add-particle ] times
-  big-bang
-  drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
-: muon-chamber ( -- )
-  bubble-chamber-window
-  1000 [ muon add-particle ] times
-  dup particles>> [ collide randomize-collision-theta ] each
-  drop ;
-
-! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-
 : original-big-bang-variant ( -- )
   bubble-chamber-window
   1789 [ muon   add-particle ] times
@@ -565,4 +567,3 @@ M:: <bubble-chamber> update-frame-buffer ( BUBBLE-CHAMBER -- )
    111 [ axion  add-particle ] times
   dup particles>> [ collide randomize-collision-theta ] each
   drop ;
-

extra/bubble-chamber/hadron-chamber/hadron-chamber.factor

@@ -0,0 +1,8 @@
+
+USING: ui bubble-chamber ;
+
+IN: bubble-chamber.hadron-chamber
+
+: main ( -- ) [ hadron-chamber ] with-ui ;
+
+MAIN: main

extra/bubble-chamber/hadron-chamber/tags.txt

@@ -0,0 +1 @@
+demos

extra/bubble-chamber/original/original.factor

@@ -0,0 +1,8 @@
+
+USING: ui bubble-chamber ;
+
+IN: bubble-chamber.original
+
+: main ( -- ) [ original ] with-ui ;
+
+MAIN: main

extra/bubble-chamber/original/tags.txt

@@ -0,0 +1 @@
+demos

extra/bubble-chamber/ten-hadrons/tags.txt

@@ -0,0 +1 @@
+demos

extra/bubble-chamber/ten-hadrons/ten-hadrons.factor

@@ -0,0 +1,8 @@
+
+USING: ui bubble-chamber ;
+
+IN: bubble-chamber.ten-hadrons
+
+: main ( -- ) [ ten-hadrons ] with-ui ;
+
+MAIN: main

extra/fuel/fuel.factor

@@ -163,32 +163,35 @@ M: source-file fuel-pprint path>> fuel-pprint ;
 : fuel-get-edit-location ( defspec -- )
     where [
        first2 [ (normalize-path) ] dip 2array fuel-eval-set-result
-    ] when* ;
+    ] when* ; inline
 
 : fuel-get-vocab-location ( vocab -- )
-    >vocab-link fuel-get-edit-location ;
+    >vocab-link fuel-get-edit-location ; inline
 
 : (fuel-get-vocabs) ( -- seq )
     all-vocabs-seq [ vocab-name ] map ; inline
 
 : fuel-get-vocabs ( -- )
-    (fuel-get-vocabs) fuel-eval-set-result ;
+    (fuel-get-vocabs) fuel-eval-set-result ; inline
 
 MEMO: (fuel-vocab-words) ( name -- seq )
     >vocab-link words [ name>> ] map ;
 
-: fuel-vocabs-words ( names/f -- seq )
-    [ (fuel-get-vocabs) ] unless* prune
-    [ (fuel-vocab-words) ] map concat natural-sort ;
+: fuel-current-words ( -- seq )
+    use get [ keys ] map concat ; inline
+
+: fuel-vocabs-words ( names -- seq )
+    prune [ (fuel-vocab-words) ] map concat ; inline
 
 : (fuel-get-words) ( prefix names/f -- seq )
-    fuel-vocabs-words swap [ drop-prefix nip length 0 = ] curry filter ;
+    [ fuel-vocabs-words ] [ fuel-current-words ] if* natural-sort
+    swap [ drop-prefix nip length 0 = ] curry filter ;
 
 : fuel-get-words ( prefix names -- )
     (fuel-get-words) fuel-eval-set-result ; inline
 
 : fuel-run-file ( path -- ) run-file ; inline
 
-: fuel-startup ( -- ) "listener" run ; inline
+: fuel-startup ( -- ) "listener" run-file ; inline
 
 MAIN: fuel-startup

misc/fuel/README

@@ -55,19 +55,28 @@ the same as C-cz)).
  - C-cz : switch to listener
  - C-co : cycle between code, tests and docs factor files
 
- - M-. : edit word at point in Emacs (also in listener)
+ - M-. : edit word at point in Emacs
  - M-TAB : complete word at point
  - C-cC-ev : edit vocabulary
 
  - C-cr, C-cC-er : eval region
  - C-M-r, C-cC-ee : eval region, extending it to definition boundaries
  - C-M-x, C-cC-ex : eval definition around point
- - C-ck, C-cC-ek : compile file
+ - C-ck, C-cC-ek : run file
 
  - C-cC-da : toggle autodoc mode
  - C-cC-dd : help for word at point
  - C-cC-ds : short help word at point
 
+* In the listener:
+
+ - TAB : complete word at point
+ - M-. : edit word at point in Emacs
+ - C-ca : toggle autodoc mode
+ - C-cv : edit vocabulary
+ - C-ch : help for word at point
+ - C-ck : run file
+
 * In the debugger (it pops up upon eval/compilation errors):
 
  - g : go to error

misc/fuel/fuel-completion.el

@@ -32,9 +32,11 @@
              (fuel-eval--send/wait '(:fuel* (fuel-get-vocabs) "fuel" (:array)))))))
   fuel-completion--vocabs)
 
-(defsubst fuel-completion--words (prefix vocabs)
-  (fuel-eval--retort-result
-   (fuel-eval--send/wait `(:fuel* (,prefix V{ ,@vocabs } fuel-get-words) t ,vocabs))))
+(defun fuel-completion--words (prefix vocabs)
+  (let ((vs (if vocabs (cons :array vocabs) 'f))
+        (us (or vocabs 't)))
+    (fuel-eval--retort-result
+     (fuel-eval--send/wait `(:fuel* (,prefix ,vs fuel-get-words) t ,us)))))
 
 
 ;;; Completions window handling, heavily inspired in slime's:
@@ -108,7 +110,7 @@ terminates a current completion."
 (defun fuel-completion--display-comp-list (completions base)
   (let ((savedp (fuel-completion--maybe-save-window-configuration)))
     (with-output-to-temp-buffer fuel-completion--comp-buffer
-      (display-completion-list completions)
+      (display-completion-list completions base)
       (let ((offset (- (point) 1 (length base))))
         (with-current-buffer standard-output
           (setq completion-base-size offset)
@@ -135,10 +137,11 @@ terminates a current completion."
 
 ;;; Completion functionality:
 
-(defsubst fuel-completion--word-list (prefix)
-  (let ((fuel-log--inhibit-p t))
-    (fuel-completion--words
-     prefix `("syntax" ,(fuel-syntax--current-vocab) ,@(fuel-syntax--usings)))))
+(defun fuel-completion--word-list (prefix)
+  (let* ((fuel-log--inhibit-p t)
+         (cv (fuel-syntax--current-vocab))
+         (vs (and cv `("syntax" ,cv ,@(fuel-syntax--usings)))))
+    (fuel-completion--words prefix vs)))
 
 (defun fuel-completion--complete (prefix)
   (let* ((words (fuel-completion--word-list prefix))

misc/fuel/fuel-listener.el

@@ -15,6 +15,8 @@
 
 (require 'fuel-eval)
 (require 'fuel-base)
+(require 'fuel-completion)
+(require 'fuel-syntax)
 (require 'comint)
 
 
@@ -68,10 +70,10 @@ buffer."
       (error "Could not run factor: image file %s not readable" image))
     (message "Starting FUEL listener ...")
     (comint-exec (fuel-listener--buffer) "factor"
-                 factor nil `("-run=fuel" ,(format "-i=%s" image)))
+                 factor nil `("-run=listener" ,(format "-i=%s" image)))
     (pop-to-buffer (fuel-listener--buffer))
     (goto-char (point-max))
-    (comint-send-string nil "USE: fuel \"\\nFUEL loaded\\n\" write\n")
+    (comint-send-string nil "USE: fuel \"FUEL loaded\\n\" write\n")
     (fuel-listener--wait-for-prompt 30)
     (message "FUEL listener up and running!")))
 
@@ -101,6 +103,17 @@ buffer."
       (goto-char (point-max))
       (unless seen (error "No prompt found!")))))
 
+
+;;; Completion support
+
+(defsubst fuel-listener--current-vocab () nil)
+(defsubst fuel-listener--usings () nil)
+
+(defun fuel-listener--setup-completion ()
+  (setq fuel-syntax--current-vocab-function 'fuel-listener--current-vocab)
+  (setq fuel-syntax--usings-function 'fuel-listener--usings)
+  (set-syntax-table fuel-syntax--syntax-table))
+
 
 ;;; Interface: starting fuel listener
 
@@ -126,13 +139,17 @@ buffer."
 \\{fuel-listener-mode-map}"
   (set (make-local-variable 'comint-prompt-regexp) fuel-listener--prompt-regex)
   (set (make-local-variable 'comint-prompt-read-only) t)
-  (setq fuel-listener--compilation-begin nil))
+  (fuel-listener--setup-completion))
 
 (define-key fuel-listener-mode-map "\C-cz" 'run-factor)
 (define-key fuel-listener-mode-map "\C-c\C-z" 'run-factor)
+(define-key fuel-listener-mode-map "\C-ca" 'fuel-autodoc-mode)
 (define-key fuel-listener-mode-map "\C-ch" 'fuel-help)
 (define-key fuel-listener-mode-map "\M-." 'fuel-edit-word-at-point)
+(define-key fuel-listener-mode-map "\C-cv" 'fuel-edit-vocabulary)
+(define-key fuel-listener-mode-map "\C-c\C-v" 'fuel-edit-vocabulary)
 (define-key fuel-listener-mode-map "\C-ck" 'fuel-run-file)
+(define-key fuel-listener-mode-map (kbd "TAB") 'fuel-completion--complete-symbol)
 
 
 (provide 'fuel-listener)

misc/fuel/fuel-syntax.el

@@ -241,7 +241,13 @@
 
 ;;; USING/IN:
 
-(defun fuel-syntax--current-vocab ()
+(make-variable-buffer-local
+ (defvar fuel-syntax--current-vocab-function 'fuel-syntax--find-in))
+
+(defsubst fuel-syntax--current-vocab ()
+  (funcall fuel-syntax--current-vocab-function))
+
+(defun fuel-syntax--find-in ()
   (let* ((vocab)
          (ip
           (save-excursion
@@ -258,7 +264,13 @@
               (setq vocab (format "%s.%s" vocab (downcase sub))))))))
     vocab))
 
-(defun fuel-syntax--usings ()
+(make-variable-buffer-local
+ (defvar fuel-syntax--usings-function 'fuel-syntax--find-usings))
+
+(defsubst fuel-syntax--usings ()
+  (funcall fuel-syntax--usings-function))
+
+(defun fuel-syntax--find-usings ()
   (save-excursion
     (let ((usings)
           (in (fuel-syntax--current-vocab)))