FUEL: Bug fixes and compatibility with Emacs 22.

db4
Jose A. Ortega Ruiz 2008-12-17 23:50:48 +01:00
parent 416f46db7c
commit de37d91304
6 changed files with 43 additions and 25 deletions

View File

@ -168,12 +168,20 @@ M: source-file fuel-pprint path>> fuel-pprint ;
: fuel-get-vocab-location ( vocab -- ) : fuel-get-vocab-location ( vocab -- )
>vocab-link fuel-get-edit-location ; inline >vocab-link fuel-get-edit-location ; inline
! Completion support
: fuel-filter-prefix ( seq prefix -- seq )
[ drop-prefix nip length 0 = ] curry filter ; inline
: (fuel-get-vocabs) ( -- seq ) : (fuel-get-vocabs) ( -- seq )
all-vocabs-seq [ vocab-name ] map ; inline all-vocabs-seq [ vocab-name ] map ; inline
: fuel-get-vocabs ( -- ) : fuel-get-vocabs ( -- )
(fuel-get-vocabs) fuel-eval-set-result ; inline (fuel-get-vocabs) fuel-eval-set-result ; inline
: fuel-get-vocabs/prefix ( prefix -- )
(fuel-get-vocabs) swap fuel-filter-prefix fuel-eval-set-result ; inline
MEMO: (fuel-vocab-words) ( name -- seq ) MEMO: (fuel-vocab-words) ( name -- seq )
>vocab-link words [ name>> ] map ; >vocab-link words [ name>> ] map ;
@ -185,7 +193,7 @@ MEMO: (fuel-vocab-words) ( name -- seq )
: (fuel-get-words) ( prefix names/f -- seq ) : (fuel-get-words) ( prefix names/f -- seq )
[ fuel-vocabs-words ] [ fuel-current-words ] if* natural-sort [ fuel-vocabs-words ] [ fuel-current-words ] if* natural-sort
swap [ drop-prefix nip length 0 = ] curry filter ; swap fuel-filter-prefix ;
: fuel-get-words ( prefix names -- ) : fuel-get-words ( prefix names -- )
(fuel-get-words) fuel-eval-set-result ; inline (fuel-get-words) fuel-eval-set-result ; inline

View File

@ -39,6 +39,15 @@
(when (equal item (ring-ref ring ind)) (when (equal item (ring-ref ring ind))
(throw 'found ind))))))) (throw 'found ind)))))))
(when (not (fboundp 'completion-table-dynamic))
(defun completion-table-dynamic (fun)
(lexical-let ((fun fun))
(lambda (string pred action)
(with-current-buffer (let ((win (minibuffer-selected-window)))
(if (window-live-p win) (window-buffer win)
(current-buffer)))
(complete-with-action action (funcall fun string) string pred))))))
;;; Utilities ;;; Utilities

View File

@ -32,24 +32,11 @@
(fuel-eval--send/wait '(:fuel* (fuel-get-vocabs) "fuel" (:array))))))) (fuel-eval--send/wait '(:fuel* (fuel-get-vocabs) "fuel" (:array)))))))
fuel-completion--vocabs) fuel-completion--vocabs)
(defvar fuel-completion--words-last (cons nil nil))
(defsubst fuel-completion--forget-words ()
(setq fuel-completion--words-last (cons nil nil)))
(defun fuel-completion--words (prefix vocabs) (defun fuel-completion--words (prefix vocabs)
(let ((vs (if vocabs (cons :array vocabs) 'f)) (let ((vs (if vocabs (cons :array vocabs) 'f))
(us (or vocabs 't))) (us (or vocabs 't)))
(if (and (car fuel-completion--words-last)
(cdr fuel-completion--words-last)
(equal (caar fuel-completion--words-last) vs)
(fuel--string-prefix-p (cdar fuel-completion--words-last) prefix))
(cdr fuel-completion--words-last)
(setcar fuel-completion--words-last (cons vocabs prefix))
(setcdr fuel-completion--words-last
(fuel-eval--retort-result (fuel-eval--retort-result
(fuel-eval--send/wait (fuel-eval--send/wait `(:fuel* (,prefix ,vs fuel-get-words) t ,us)))))
`(:fuel* (,prefix ,vs fuel-get-words) t ,us)))))))
;;; Completions window handling, heavily inspired in slime's: ;;; Completions window handling, heavily inspired in slime's:
@ -173,7 +160,6 @@ terminates a current completion."
(cons completions partial))) (cons completions partial)))
(defun fuel-completion--read-word (prompt &optional default history all) (defun fuel-completion--read-word (prompt &optional default history all)
(fuel-completion--forget-words)
(completing-read prompt (completing-read prompt
(if all fuel-completion--all-words-list-func (if all fuel-completion--all-words-list-func
fuel-completion--word-list-func) fuel-completion--word-list-func)
@ -185,7 +171,6 @@ terminates a current completion."
"Complete the symbol at point. "Complete the symbol at point.
Perform completion similar to Emacs' complete-symbol." Perform completion similar to Emacs' complete-symbol."
(interactive) (interactive)
(fuel-completion--forget-words)
(let* ((end (point)) (let* ((end (point))
(beg (fuel-syntax--symbol-start)) (beg (fuel-syntax--symbol-start))
(prefix (buffer-substring-no-properties beg end)) (prefix (buffer-substring-no-properties beg end))

View File

@ -66,7 +66,8 @@
(defsubst factor--fuel-in (in) (defsubst factor--fuel-in (in)
(cond ((null in) :in) (cond ((null in) :in)
((eq in t) "fuel-scratchpad") ((eq in 'f) 'f)
((eq in 't) "fuel-scratchpad")
((stringp in) in) ((stringp in) in)
(t (error "Invalid 'in' (%s)" in)))) (t (error "Invalid 'in' (%s)" in))))

View File

@ -152,7 +152,8 @@ displayed in the minibuffer."
fuel-help-always-ask)) fuel-help-always-ask))
(def (if ask (fuel-completion--read-word prompt (def (if ask (fuel-completion--read-word prompt
def def
'fuel-help--prompt-history) 'fuel-help--prompt-history
t)
def)) def))
(cmd `(:fuel* ((:quote ,def) ,(if see 'see 'help)) t))) (cmd `(:fuel* ((:quote ,def) ,(if see 'see 'help)) t)))
(message "Looking up '%s' ..." def) (message "Looking up '%s' ..." def)
@ -229,6 +230,7 @@ buffer."
(define-key map "b" 'fuel-help-previous) (define-key map "b" 'fuel-help-previous)
(define-key map "f" 'fuel-help-next) (define-key map "f" 'fuel-help-next)
(define-key map "l" 'fuel-help-previous) (define-key map "l" 'fuel-help-previous)
(define-key map "p" 'fuel-help-previous)
(define-key map "n" 'fuel-help-next) (define-key map "n" 'fuel-help-next)
(define-key map (kbd "SPC") 'scroll-up) (define-key map (kbd "SPC") 'scroll-up)
(define-key map (kbd "S-SPC") 'scroll-down) (define-key map (kbd "S-SPC") 'scroll-down)

View File

@ -39,14 +39,24 @@
;;; User commands ;;; User commands
(defun fuel-run-file (&optional arg) (defun fuel-mode--read-file (arg)
"Sends the current file to Factor for compilation.
With prefix argument, ask for the file to run."
(interactive "P")
(let* ((file (or (and arg (read-file-name "File: " nil (buffer-file-name) t)) (let* ((file (or (and arg (read-file-name "File: " nil (buffer-file-name) t))
(buffer-file-name))) (buffer-file-name)))
(file (expand-file-name file)) (file (expand-file-name file))
(buffer (find-file-noselect file))) (buffer (find-file-noselect file)))
(when (and buffer
(buffer-modified-p buffer)
(y-or-n-p "Save file? "))
(save-buffer buffer))
(cons file buffer)))
(defun fuel-run-file (&optional arg)
"Sends the current file to Factor for compilation.
With prefix argument, ask for the file to run."
(interactive "P")
(let* ((f/b (fuel-mode--read-file arg))
(file (car f/b))
(buffer (cdr f/b)))
(when buffer (when buffer
(with-current-buffer buffer (with-current-buffer buffer
(message "Compiling %s ..." file) (message "Compiling %s ..." file)
@ -61,6 +71,7 @@ With prefix argument, ask for the file to run."
(message "Compiling %s ... OK!" file) (message "Compiling %s ... OK!" file)
(message ""))) (message "")))
(defun fuel-eval-region (begin end &optional arg) (defun fuel-eval-region (begin end &optional arg)
"Sends region to Fuel's listener for evaluation. "Sends region to Fuel's listener for evaluation.
Unless called with a prefix, switchs to the compilation results Unless called with a prefix, switchs to the compilation results
@ -191,9 +202,10 @@ interacting with a factor listener is at your disposal.
(define-key fuel-mode-map (vector '(control ?c) `(control ,p) k) c) (define-key fuel-mode-map (vector '(control ?c) `(control ,p) k) c)
(define-key fuel-mode-map (vector '(control ?c) `(control ,p) `(control ,k)) c)) (define-key fuel-mode-map (vector '(control ?c) `(control ,p) `(control ,k)) c))
(fuel-mode--key-1 ?z 'run-factor)
(fuel-mode--key-1 ?k 'fuel-run-file) (fuel-mode--key-1 ?k 'fuel-run-file)
(fuel-mode--key-1 ?l 'fuel-run-file)
(fuel-mode--key-1 ?r 'fuel-eval-region) (fuel-mode--key-1 ?r 'fuel-eval-region)
(fuel-mode--key-1 ?z 'run-factor)
(define-key fuel-mode-map "\C-\M-x" 'fuel-eval-definition) (define-key fuel-mode-map "\C-\M-x" 'fuel-eval-definition)
(define-key fuel-mode-map "\C-\M-r" 'fuel-eval-extended-region) (define-key fuel-mode-map "\C-\M-r" 'fuel-eval-extended-region)
@ -201,6 +213,7 @@ interacting with a factor listener is at your disposal.
(define-key fuel-mode-map (kbd "M-TAB") 'fuel-completion--complete-symbol) (define-key fuel-mode-map (kbd "M-TAB") 'fuel-completion--complete-symbol)
(fuel-mode--key ?e ?e 'fuel-eval-extended-region) (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 ?r 'fuel-eval-region)
(fuel-mode--key ?e ?v 'fuel-edit-vocabulary) (fuel-mode--key ?e ?v 'fuel-edit-vocabulary)
(fuel-mode--key ?e ?w 'fuel-edit-word) (fuel-mode--key ?e ?w 'fuel-edit-word)