Fix conflict

db4
Slava Pestov 2008-12-18 17:10:01 -06:00
commit b11cbaa3af
11 changed files with 194 additions and 118 deletions

View File

@ -7,7 +7,7 @@ eval help io io.files io.pathnames io.streams.string kernel
lexer listener listener.private make math memoize namespaces lexer listener listener.private make math memoize namespaces
parser prettyprint prettyprint.config quotations sequences sets parser prettyprint prettyprint.config quotations sequences sets
sorting source-files strings tools.vocabs vectors vocabs sorting source-files strings tools.vocabs vectors vocabs
vocabs.loader vocabs.parser ; vocabs.loader vocabs.parser summary ;
IN: fuel IN: fuel
@ -160,6 +160,10 @@ M: source-file fuel-pprint path>> fuel-pprint ;
: fuel-end-eval ( -- ) [ ] (fuel-end-eval) ; inline : fuel-end-eval ( -- ) [ ] (fuel-end-eval) ; inline
: fuel-run-file ( path -- ) run-file ; inline
! Edit locations
: fuel-get-edit-location ( defspec -- ) : fuel-get-edit-location ( defspec -- )
where [ where [
first2 [ (normalize-path) ] dip 2array fuel-eval-set-result first2 [ (normalize-path) ] dip 2array fuel-eval-set-result
@ -168,12 +172,23 @@ 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 prune ; 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
: fuel-vocab-summary ( name -- )
>vocab-link summary 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,12 +200,13 @@ 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
: fuel-run-file ( path -- ) run-file ; inline
! -run=fuel support
: fuel-startup ( -- ) "listener" run-file ; inline : fuel-startup ( -- ) "listener" run-file ; inline

View File

@ -90,5 +90,7 @@ C-cC-eC-r is the same as C-cC-er)).
- RET : help for word at point - RET : help for word at point
- f/b : next/previous page - f/b : next/previous page
- SPC/S-SPC : scroll up/down - SPC/S-SPC : scroll up/down
- TAB/S-TAB : next/previous headline
- C-cz : switch to listener
- q: bury buffer - q: bury buffer

View File

@ -59,23 +59,6 @@ code in the buffer."
:type 'hook :type 'hook
:group 'factor-mode) :group 'factor-mode)
;;; Faces:
(fuel-font-lock--define-faces
factor-font-lock font-lock factor-mode
((comment comment "comments")
(constructor type "constructors (<foo>)")
(declaration keyword "declaration words")
(parsing-word keyword "parsing words")
(setter-word function-name "setter words (>>foo)")
(stack-effect comment "stack effect specifications")
(string string "strings")
(symbol variable-name "name of symbol being defined")
(type-name type "type names")
(vocabulary-name constant "vocabulary names")
(word function-name "word, generic or method being defined")))
;;; Syntax table: ;;; Syntax table:

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
@ -61,6 +70,11 @@
(defsubst empty-string-p (str) (equal str "")) (defsubst empty-string-p (str) (equal str ""))
(defun fuel--string-prefix-p (prefix str)
(and (>= (length str) (length prefix))
(string= (substring-no-properties 0 (length prefix) str)
(substring-no-properties prefix))))
(defun fuel--respecting-message (format &rest format-args) (defun fuel--respecting-message (format &rest format-args)
"Display TEXT as a message, without hiding any minibuffer contents." "Display TEXT as a message, without hiding any minibuffer contents."
(let ((text (format " [%s]" (apply #'format format format-args)))) (let ((text (format " [%s]" (apply #'format format format-args))))

View File

@ -32,6 +32,10 @@
(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)
(defsubst fuel-completion--vocab-list (prefix)
(fuel-eval--retort-result
(fuel-eval--send/wait `(:fuel* (,prefix fuel-get-vocabs/prefix) t t))))
(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)))
@ -55,7 +59,7 @@ performed."))
If this window is no longer active or displaying the completions If this window is no longer active or displaying the completions
buffer then we can ignore `fuel-completion--window-cfg'.")) buffer then we can ignore `fuel-completion--window-cfg'."))
(defun fuel-completion--maybe-save-window-configuration () (defun fuel-completion--save-window-cfg ()
"Maybe save the current window configuration. "Maybe save the current window configuration.
Return true if the configuration was saved." Return true if the configuration was saved."
(unless (or fuel-completion--window-cfg (unless (or fuel-completion--window-cfg
@ -66,17 +70,17 @@ Return true if the configuration was saved."
(defun fuel-completion--delay-restoration () (defun fuel-completion--delay-restoration ()
(add-hook 'pre-command-hook (add-hook 'pre-command-hook
'fuel-completion--maybe-restore-window-configuration 'fuel-completion--maybe-restore-window-cfg
nil t)) nil t))
(defun fuel-completion--forget-window-configuration () (defun fuel-completion--forget-window-cfg ()
(setq fuel-completion--window-cfg nil) (setq fuel-completion--window-cfg nil)
(setq fuel-completion--completions-window nil)) (setq fuel-completion--completions-window nil))
(defun fuel-completion--restore-window-configuration () (defun fuel-completion--restore-window-cfg ()
"Restore the window config if available." "Restore the window config if available."
(remove-hook 'pre-command-hook (remove-hook 'pre-command-hook
'fuel-completion--maybe-restore-window-configuration) 'fuel-completion--maybe-restore-window-cfg)
(when (and fuel-completion--window-cfg (when (and fuel-completion--window-cfg
(fuel-completion--window-active-p)) (fuel-completion--window-active-p))
(save-excursion (save-excursion
@ -85,21 +89,21 @@ Return true if the configuration was saved."
(when (buffer-live-p fuel-completion--comp-buffer) (when (buffer-live-p fuel-completion--comp-buffer)
(kill-buffer fuel-completion--comp-buffer)))) (kill-buffer fuel-completion--comp-buffer))))
(defun fuel-completion--maybe-restore-window-configuration () (defun fuel-completion--maybe-restore-window-cfg ()
"Restore the window configuration, if the following command "Restore the window configuration, if the following command
terminates a current completion." terminates a current completion."
(remove-hook 'pre-command-hook (remove-hook 'pre-command-hook
'fuel-completion--maybe-restore-window-configuration) 'fuel-completion--maybe-restore-window-cfg)
(condition-case err (condition-case err
(cond ((find last-command-char "()\"'`,# \r\n:") (cond ((find last-command-char "()\"'`,# \r\n:")
(fuel-completion--restore-window-configuration)) (fuel-completion--restore-window-cfg))
((not (fuel-completion--window-active-p)) ((not (fuel-completion--window-active-p))
(fuel-completion--forget-window-configuration)) (fuel-completion--forget-window-cfg))
(t (fuel-completion--delay-restoration))) (t (fuel-completion--delay-restoration)))
(error (error
;; Because this is called on the pre-command-hook, we mustn't let ;; Because this is called on the pre-command-hook, we mustn't let
;; errors propagate. ;; errors propagate.
(message "Error in fuel-completion--restore-window-configuration: %S" err)))) (message "Error in fuel-completion--restore-window-cfg: %S" err))))
(defun fuel-completion--window-active-p () (defun fuel-completion--window-active-p ()
"Is the completion window currently active?" "Is the completion window currently active?"
@ -108,7 +112,7 @@ terminates a current completion."
fuel-completion--comp-buffer))) fuel-completion--comp-buffer)))
(defun fuel-completion--display-comp-list (completions base) (defun fuel-completion--display-comp-list (completions base)
(let ((savedp (fuel-completion--maybe-save-window-configuration))) (let ((savedp (fuel-completion--save-window-cfg)))
(with-output-to-temp-buffer fuel-completion--comp-buffer (with-output-to-temp-buffer fuel-completion--comp-buffer
(display-completion-list completions base) (display-completion-list completions base)
(let ((offset (- (point) 1 (length base)))) (let ((offset (- (point) 1 (length base))))
@ -152,14 +156,16 @@ terminates a current completion."
(defvar fuel-completion--all-words-list-func (defvar fuel-completion--all-words-list-func
(completion-table-dynamic 'fuel-completion--all-words-list)) (completion-table-dynamic 'fuel-completion--all-words-list))
(defun fuel-completion--complete (prefix) (defun fuel-completion--complete (prefix vocabs)
(let* ((words (fuel-completion--word-list prefix)) (let* ((words (if vocabs
(fuel-completion--vocabs)
(fuel-completion--word-list prefix)))
(completions (all-completions prefix words)) (completions (all-completions prefix words))
(partial (try-completion prefix words)) (partial (try-completion prefix words))
(partial (if (eq partial t) prefix partial))) (partial (if (eq partial t) prefix partial)))
(cons completions partial))) (cons completions partial)))
(defsubst fuel-completion--read-word (prompt &optional default history all) (defun fuel-completion--read-word (prompt &optional default history all)
(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)
@ -174,16 +180,16 @@ Perform completion similar to Emacs' complete-symbol."
(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))
(result (fuel-completion--complete prefix)) (result (fuel-completion--complete prefix (fuel-syntax--in-using)))
(completions (car result)) (completions (car result))
(partial (cdr result))) (partial (cdr result)))
(cond ((null completions) (cond ((null completions)
(fuel--respecting-message "Can't find completion for %S" prefix) (fuel--respecting-message "Can't find completion for %S" prefix)
(fuel-completion--restore-window-configuration)) (fuel-completion--restore-window-cfg))
(t (insert-and-inherit (substring partial (length prefix))) (t (insert-and-inherit (substring partial (length prefix)))
(cond ((= (length completions) 1) (cond ((= (length completions) 1)
(fuel--respecting-message "Sole completion") (fuel--respecting-message "Sole completion")
(fuel-completion--restore-window-configuration)) (fuel-completion--restore-window-cfg))
(t (fuel--respecting-message "Complete but not unique") (t (fuel--respecting-message "Complete but not unique")
(fuel-completion--display-or-scroll completions (fuel-completion--display-or-scroll completions
partial))))))) partial)))))))

View File

@ -46,8 +46,7 @@
(cons :id (random)) (cons :id (random))
(cons :string str) (cons :string str)
(cons :continuation cont) (cons :continuation cont)
(cons :buffer (or sender-buffer (current-buffer))) (cons :buffer (or sender-buffer (current-buffer)))))
(cons :output "")))
(defsubst fuel-con--request-p (req) (defsubst fuel-con--request-p (req)
(and (listp req) (eq (car req) :fuel-connection-request))) (and (listp req) (eq (car req) :fuel-connection-request)))
@ -64,11 +63,6 @@
(defsubst fuel-con--request-buffer (req) (defsubst fuel-con--request-buffer (req)
(cdr (assoc :buffer req))) (cdr (assoc :buffer req)))
(defun fuel-con--request-output (req &optional suffix)
(let ((cell (assoc :output req)))
(when suffix (setcdr cell (concat (cdr cell) suffix)))
(cdr cell)))
(defsubst fuel-con--request-deactivate (req) (defsubst fuel-con--request-deactivate (req)
(setcdr (assoc :continuation req) nil)) (setcdr (assoc :continuation req) nil))
@ -143,12 +137,11 @@
(defconst fuel-con--init-stanza (format "USE: fuel %S write" fuel-con--eot-marker)) (defconst fuel-con--init-stanza (format "USE: fuel %S write" fuel-con--eot-marker))
(defconst fuel-con--comint-finished-regex (defconst fuel-con--comint-finished-regex
(format "%s%s" fuel-con--eot-marker fuel-con--prompt-regex)) (format "^%s%s$" fuel-con--eot-marker fuel-con--prompt-regex))
(defun fuel-con--setup-comint () (defun fuel-con--setup-comint ()
(comint-redirect-cleanup) (comint-redirect-cleanup)
(add-hook 'comint-redirect-filter-functions (set (make-local-variable 'comint-redirect-insert-matching-regexp) t)
'fuel-con--comint-redirect-filter t t)
(add-hook 'comint-redirect-hook (add-hook 'comint-redirect-hook
'fuel-con--comint-redirect-hook nil t)) 'fuel-con--comint-redirect-hook nil t))
@ -158,45 +151,45 @@
;;; Requests handling: ;;; Requests handling:
(defsubst fuel-con--comint-buffer ()
(get-buffer-create " *fuel connection retort*"))
(defsubst fuel-con--comint-buffer-form ()
(with-current-buffer (fuel-con--comint-buffer)
(goto-char (point-min))
(condition-case nil
(read (current-buffer))
(error (list 'fuel-con-error (buffer-string))))))
(defun fuel-con--process-next (con) (defun fuel-con--process-next (con)
(when (not (fuel-con--connection-current-request con)) (when (not (fuel-con--connection-current-request con))
(let* ((buffer (fuel-con--connection-buffer con)) (let* ((buffer (fuel-con--connection-buffer con))
(req (fuel-con--connection-pop-request con)) (req (fuel-con--connection-pop-request con))
(str (and req (fuel-con--request-string req)))) (str (and req (fuel-con--request-string req)))
(cbuf (with-current-buffer (fuel-con--comint-buffer)
(erase-buffer)
(current-buffer))))
(if (not (buffer-live-p buffer)) (if (not (buffer-live-p buffer))
(fuel-con--connection-cancel-timer con) (fuel-con--connection-cancel-timer con)
(when (and buffer req str) (when (and buffer req str)
(set-buffer buffer) (set-buffer buffer)
(fuel-log--info "<%s>: %s" (fuel-con--request-id req) str) (fuel-log--info "<%s>: %s" (fuel-con--request-id req) str)
(comint-redirect-send-command (format "%s" str) (comint-redirect-send-command (format "%s" str) cbuf nil t))))))
(fuel-log--buffer) nil t))))))
(defun fuel-con--process-completed-request (req) (defun fuel-con--process-completed-request (req)
(let ((str (fuel-con--request-output req)) (let ((cont (fuel-con--request-continuation req))
(cont (fuel-con--request-continuation req))
(id (fuel-con--request-id req)) (id (fuel-con--request-id req))
(rstr (fuel-con--request-string req)) (rstr (fuel-con--request-string req))
(buffer (fuel-con--request-buffer req))) (buffer (fuel-con--request-buffer req)))
(if (not cont) (if (not cont)
(fuel-log--warn "<%s> Droping result for request %S (%s)" (fuel-log--warn "<%s> Droping result for request %S (%s)"
id rstr str) id rstr req)
(condition-case cerr (condition-case cerr
(with-current-buffer (or buffer (current-buffer)) (with-current-buffer (or buffer (current-buffer))
(funcall cont str) (funcall cont (fuel-con--comint-buffer-form))
(fuel-log--info "<%s>: processed\n\t%s" id str)) (fuel-log--info "<%s>: processed\n\t%s" id req))
(error (fuel-log--error "<%s>: continuation failed %S \n\t%s" (error (fuel-log--error
id rstr cerr)))))) "<%s>: continuation failed %S \n\t%s" id rstr cerr))))))
(defvar fuel-con--debug-comint-p nil)
(defun fuel-con--comint-redirect-filter (str)
(if (not fuel-con--connection)
(fuel-log--error "No connection in buffer (%s)" str)
(let ((req (fuel-con--connection-current-request fuel-con--connection)))
(if (not req) (fuel-log--error "No current request (%s)" str)
(fuel-con--request-output req str)
(fuel-log--info "<%s>: in progress" (fuel-con--request-id req)))))
(if fuel-con--debug-comint-p (fuel--shorten-str str 256) ""))
(defun fuel-con--comint-redirect-hook () (defun fuel-con--comint-redirect-hook ()
(if (not fuel-con--connection) (if (not fuel-con--connection)

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))))
@ -115,17 +116,15 @@
(defsubst fuel-eval--retort-result (ret) (nth 1 ret)) (defsubst fuel-eval--retort-result (ret) (nth 1 ret))
(defsubst fuel-eval--retort-output (ret) (nth 2 ret)) (defsubst fuel-eval--retort-output (ret) (nth 2 ret))
(defsubst fuel-eval--retort-p (ret) (listp ret)) (defsubst fuel-eval--retort-p (ret)
(and (listp ret) (= 3 (length ret))))
(defsubst fuel-eval--make-parse-error-retort (str) (defsubst fuel-eval--make-parse-error-retort (str)
(fuel-eval--retort-make (cons 'fuel-parse-retort-error str) nil)) (fuel-eval--retort-make (cons 'fuel-parse-retort-error str) nil))
(defun fuel-eval--parse-retort (str) (defun fuel-eval--parse-retort (ret)
(save-current-buffer (if (fuel-eval--retort-p ret) ret
(condition-case nil (fuel-eval--make-parse-error-retort ret)))
(let ((ret (car (read-from-string str))))
(if (fuel-eval--retort-p ret) ret (error)))
(error (fuel-eval--make-parse-error-retort str)))))
(defsubst fuel-eval--error-name (err) (car err)) (defsubst fuel-eval--error-name (err) (car err))

View File

@ -13,8 +13,8 @@
;;; Code: ;;; Code:
(require 'fuel-base)
(require 'fuel-syntax) (require 'fuel-syntax)
(require 'fuel-base)
(require 'font-lock) (require 'font-lock)
@ -39,6 +39,21 @@
',faces))) ',faces)))
(,setup)))) (,setup))))
(fuel-font-lock--define-faces
factor-font-lock font-lock factor-mode
((comment comment "comments")
(constructor type "constructors (<foo>)")
(declaration keyword "declaration words")
(parsing-word keyword "parsing words")
(setter-word function-name "setter words (>>foo)")
(getter-word function-name "getter words (foo>>)")
(stack-effect comment "stack effect specifications")
(string string "strings")
(symbol variable-name "name of symbol being defined")
(type-name type "type names")
(vocabulary-name constant "vocabulary names")
(word function-name "word, generic or method being defined")))
;;; Font lock: ;;; Font lock:
@ -59,7 +74,8 @@
(2 'factor-font-lock-word)) (2 'factor-font-lock-word))
(,fuel-syntax--parent-type-regex 1 'factor-font-lock-type-name) (,fuel-syntax--parent-type-regex 1 'factor-font-lock-type-name)
(,fuel-syntax--constructor-regex . 'factor-font-lock-constructor) (,fuel-syntax--constructor-regex . 'factor-font-lock-constructor)
(,fuel-syntax--setter-regex . 'factor-font-lock-setter-word) (,fuel-syntax--setter-regex 2 'factor-font-lock-setter-word)
(,fuel-syntax--getter-regex 2 'factor-font-lock-getter-word)
(,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol) (,fuel-syntax--symbol-definition-regex 2 'factor-font-lock-symbol)
(,fuel-syntax--use-line-regex 1 'factor-font-lock-vocabulary-name)) (,fuel-syntax--use-line-regex 1 'factor-font-lock-vocabulary-name))
"Font lock keywords definition for Factor mode.") "Font lock keywords definition for Factor mode.")

View File

@ -76,12 +76,15 @@
(let ((word (or word (fuel-syntax-symbol-at-point))) (let ((word (or word (fuel-syntax-symbol-at-point)))
(fuel-log--inhibit-p t)) (fuel-log--inhibit-p t))
(when word (when word
(let* ((cmd `(:fuel* (((:quote ,word) synopsis :get)) t)) (let* ((cmd (if (fuel-syntax--in-using)
(ret (fuel-eval--send/wait cmd 20))) `(:fuel* (,word fuel-vocab-summary) t t)
(when (and ret (not (fuel-eval--retort-error ret))) `(:fuel* (((:quote ,word) synopsis :get)) t)))
(ret (fuel-eval--send/wait cmd 20))
(res (fuel-eval--retort-result ret)))
(when (and ret (not (fuel-eval--retort-error ret)) (stringp res))
(if fuel-help-minibuffer-font-lock (if fuel-help-minibuffer-font-lock
(fuel-help--font-lock-str (fuel-eval--retort-result ret)) (fuel-help--font-lock-str res)
(fuel-eval--retort-result ret))))))) res))))))
(make-variable-buffer-local (make-variable-buffer-local
(defvar fuel-autodoc-mode-string " A" (defvar fuel-autodoc-mode-string " A"
@ -152,7 +155,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)
@ -176,14 +180,41 @@ displayed in the minibuffer."
(when (re-search-forward (format "^%s" def) nil t) (when (re-search-forward (format "^%s" def) nil t)
(beginning-of-line) (beginning-of-line)
(kill-region (point-min) (point)) (kill-region (point-min) (point))
(next-line)
(open-line 1)
(fuel-help--history-push (cons def (buffer-string))))) (fuel-help--history-push (cons def (buffer-string)))))
(set-buffer-modified-p nil) (set-buffer-modified-p nil)
(pop-to-buffer hb) (pop-to-buffer hb)
(goto-char (point-min)) (goto-char (point-min))
(message "%s" def))) (message "%s" def)))
;;; Help mode font lock:
(defconst fuel-help--headlines
(regexp-opt '("Class description"
"Definition"
"Errors"
"Examples"
"Generic word contract"
"Inputs and outputs"
"Methods"
"Notes"
"Parent topics:"
"See also"
"Syntax"
"Variable description"
"Variable value"
"Vocabulary"
"Warning"
"Word description")
t))
(defconst fuel-help--headlines-regexp (format "^%s" fuel-help--headlines))
(defconst fuel-help--font-lock-keywords
`(,@fuel-font-lock--font-lock-keywords
(,fuel-help--headlines-regexp . 'fuel-help-font-lock-headlines)))
;;; Interactive help commands: ;;; Interactive help commands:
@ -221,8 +252,18 @@ buffer."
(error "No previous page")) (error "No previous page"))
(fuel-help--insert-contents (car item) (cdr item) t))) (fuel-help--insert-contents (car item) (cdr item) t)))
(defun fuel-help-next-headline (&optional count)
(interactive "P")
(end-of-line)
(when (re-search-forward fuel-help--headlines-regexp nil t (or count 1))
(beginning-of-line)))
(defun fuel-help-previous-headline (&optional count)
(interactive "P")
(re-search-backward fuel-help--headlines-regexp nil t count))
;;;; Factor help mode: ;;;; Help mode map:
(defvar fuel-help-mode-map (defvar fuel-help-mode-map
(let ((map (make-sparse-keymap))) (let ((map (make-sparse-keymap)))
@ -231,35 +272,19 @@ 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 "TAB") 'fuel-help-next-headline)
(define-key map (kbd "S-TAB") 'fuel-help-previous-headline)
(define-key map [(backtab)] 'fuel-help-previous-headline)
(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)
(define-key map "\C-cz" 'run-factor)
(define-key map "\C-c\C-z" 'run-factor)
map)) map))
(defconst fuel-help--headlines
(regexp-opt '("Class description" ;;; Help mode definition:
"Definition"
"Errors"
"Examples"
"Generic word contract"
"Inputs and outputs"
"Methods"
"Notes"
"Parent topics:"
"See also"
"Syntax"
"Variable description"
"Variable value"
"Vocabulary"
"Warning"
"Word description")
t))
(defconst fuel-help--headlines-regexp (format "^%s" fuel-help--headlines))
(defconst fuel-help--font-lock-keywords
`(,@fuel-font-lock--font-lock-keywords
(,fuel-help--headlines-regexp . 'fuel-help-font-lock-headlines)))
(defun fuel-help-mode () (defun fuel-help-mode ()
"Major mode for browsing Factor documentation. "Major mode for browsing Factor documentation.

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)

View File

@ -64,7 +64,8 @@
'("flushable" "foldable" "inline" "parsing" "recursive")) '("flushable" "foldable" "inline" "parsing" "recursive"))
(defconst fuel-syntax--declaration-words-regex (defconst fuel-syntax--declaration-words-regex
(regexp-opt fuel-syntax--declaration-words 'words)) (format "%s\\($\\| \\)"
(regexp-opt fuel-syntax--declaration-words 'words)))
(defsubst fuel-syntax--second-word-regex (prefixes) (defsubst fuel-syntax--second-word-regex (prefixes)
(format "^%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t))) (format "^%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t)))
@ -82,7 +83,8 @@
(defconst fuel-syntax--constructor-regex "<[^ >]+>") (defconst fuel-syntax--constructor-regex "<[^ >]+>")
(defconst fuel-syntax--setter-regex "\\W>>[^ ]+\\b") (defconst fuel-syntax--getter-regex "\\( \\|^\\)\\([^ ]+>>\\)\\( \\|$\\)")
(defconst fuel-syntax--setter-regex "\\( \\|^\\)\\(>>[^ ]+\\)\\( \\|$\\)")
(defconst fuel-syntax--symbol-definition-regex (defconst fuel-syntax--symbol-definition-regex
(fuel-syntax--second-word-regex '("SYMBOL:" "VAR:"))) (fuel-syntax--second-word-regex '("SYMBOL:" "VAR:")))
@ -232,6 +234,13 @@
(defsubst fuel-syntax--at-using () (defsubst fuel-syntax--at-using ()
(looking-at fuel-syntax--using-lines-regex)) (looking-at fuel-syntax--using-lines-regex))
(defun fuel-syntax--in-using ()
(let ((p (point)))
(save-excursion
(and (re-search-backward "^USING: " nil t)
(re-search-forward " ;" nil t)
(< p (match-end 0))))))
(defsubst fuel-syntax--beginning-of-defun (&optional times) (defsubst fuel-syntax--beginning-of-defun (&optional times)
(re-search-backward fuel-syntax--begin-of-def-regex nil t times)) (re-search-backward fuel-syntax--begin-of-def-regex nil t times))