Merge branch 'master' of git://factorcode.org/git/factor
						commit
						cc027b8b1a
					
				|  | @ -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 | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -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 | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -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: | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -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)))) | ||||||
|  |  | ||||||
|  | @ -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))))))) | ||||||
|  |  | ||||||
|  | @ -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) | ||||||
|  |  | ||||||
|  | @ -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)) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
|  | @ -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.") | ||||||
|  |  | ||||||
|  | @ -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. | ||||||
|  |  | ||||||
|  | @ -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) | ||||||
|  |  | ||||||
|  | @ -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)) | ||||||
| 
 | 
 | ||||||
|  |  | ||||||
		Loading…
	
		Reference in New Issue