diff --git a/extra/easy-help/easy-help.factor b/extra/easy-help/easy-help.factor index b99f2e248c..824a638fd4 100644 --- a/extra/easy-help/easy-help.factor +++ b/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 - [ "" = not ] filter - 2 group + string-lines + 1 tail + [ dup " " head? [ 4 tail ] [ ] if ] map + [ " " split1 [ " " first = ] trim-left 2array ] map \ $values prefix parsed - ; parsing \ No newline at end of file + ; 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 + +! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! + diff --git a/extra/easy-help/expand-markup/expand-markup.factor b/extra/easy-help/expand-markup/expand-markup.factor new file mode 100644 index 0000000000..7550158c7e --- /dev/null +++ b/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 ; diff --git a/extra/fuel/fuel.factor b/extra/fuel/fuel.factor index 57387e70be..35ca438f31 100644 --- a/extra/fuel/fuel.factor +++ b/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 -combinators compiler.units continuations debugger definitions -eval help io io.files io.pathnames io.streams.string kernel -lexer listener listener.private make math math.order memoize -namespaces parser prettyprint prettyprint.config quotations -sequences sets sorting source-files strings summary tools.vocabs -vectors vocabs vocabs.loader vocabs.parser words ; +USING: accessors arrays assocs classes.tuple combinators +compiler.units continuations debugger definitions io io.pathnames +io.streams.string kernel lexer math math.order memoize namespaces +parser prettyprint sequences sets sorting source-files strings summary +tools.vocabs vectors vocabs 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 ) diff --git a/extra/size-of/size-of.factor b/extra/size-of/size-of.factor index 4f4743c6b6..c5fae3c647 100644 --- a/extra/size-of/size-of.factor +++ b/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: ! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! - \ No newline at end of file diff --git a/misc/fuel/README b/misc/fuel/README index ee835f2c5c..b670eef84d 100644 --- a/misc/fuel/README +++ b/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) diff --git a/misc/fuel/fuel-base.el b/misc/fuel/fuel-base.el index 219f821daa..f168cdf9b8 100644 --- a/misc/fuel/fuel-base.el +++ b/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) diff --git a/misc/fuel/fuel-connection.el b/misc/fuel/fuel-connection.el index d029f6a056..05ddad4b1e 100644 --- a/misc/fuel/fuel-connection.el +++ b/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))))) diff --git a/misc/fuel/fuel-debug-uses.el b/misc/fuel/fuel-debug-uses.el new file mode 100644 index 0000000000..2930eff4d6 --- /dev/null +++ b/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 +;; 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 diff --git a/misc/fuel/fuel-debug.el b/misc/fuel/fuel-debug.el index cac4834f3b..f376bde1c9 100644 --- a/misc/fuel/fuel-debug.el +++ b/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 - `(:fuel ((:factor ,info)))) - "" - nil - (fuel-debug--buffer-file)) + (unless (fuel-debug--display-retort + (fuel-eval--send/wait `(:fuel ((:factor ,info)))) "") (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 diff --git a/misc/fuel/fuel-eval.el b/misc/fuel/fuel-eval.el index 32073f9053..204e794925 100644 --- a/misc/fuel/fuel-eval.el +++ b/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))) diff --git a/misc/fuel/fuel-font-lock.el b/misc/fuel/fuel-font-lock.el index 502e29707c..1c37de7b18 100644 --- a/misc/fuel/fuel-font-lock.el +++ b/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) diff --git a/misc/fuel/fuel-listener.el b/misc/fuel/fuel-listener.el index 2c3e46695d..eb159eb56e 100644 --- a/misc/fuel/fuel-listener.el +++ b/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)) diff --git a/misc/fuel/fuel-mode.el b/misc/fuel/fuel-mode.el index 608072c87a..1074f60f5f 100644 --- a/misc/fuel/fuel-mode.el +++ b/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) - (fuel-eval--send `(:fuel (,file fuel-run-file)) - `(lambda (r) (fuel--run-file-cont r ,file))))))) + (let ((msg (format "Compiling %s ..." file))) + (fuel-debug--prepare-compilation file msg) + (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 - (format "%s successfully compiled" file) - nil - file) + (if (fuel-debug--display-retort ret (format "%s successfully compiled" 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) - "[\f\n\r\v]+" t)) + (let* ((rstr (buffer-substring begin end)) + (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 - (buffer-file-name)))) + arg))) (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) diff --git a/misc/fuel/fuel-popup.el b/misc/fuel/fuel-popup.el index f18e77b321..b8a967d3b0 100644 --- a/misc/fuel/fuel-popup.el +++ b/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 diff --git a/misc/fuel/fuel-syntax.el b/misc/fuel/fuel-syntax.el index f5e9cb31d2..04cf0e615c 100644 --- a/misc/fuel/fuel-syntax.el +++ b/misc/fuel/fuel-syntax.el @@ -43,20 +43,26 @@ ;;; Regexps galore: (defconst fuel-syntax--parsing-words - '("{" "}" "^:" "^::" ";" "<<" ">" - "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:" - "UNION:" "USE:" "USING:" "V{" "VARS:" "W{")) + "TUPLE:" "t" "t?" "TYPEDEF:" + "UNION:" "USE:" "USING:" "VARS:" + "call-next-method" "delimiter" "f" "initial:" "read-only")) -(defconst fuel-syntax--parsing-words-ext-regex - (regexp-opt '("B" "call-next-method" "delimiter" "f" "initial:" "read-only") - 'words)) +(defconst fuel-syntax--bracers + '("B" "BV" "C" "CS" "H" "T" "V" "W")) + +(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 - (modify-syntax-entry ?\t " " table) + ;; Whitespace (TAB is not whitespace) (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\\)" (2 "<") (3 ">")) - ("\\(!(\\) .* \\()\\)" (1 "<") (2 ">")) + `(("\\_<\\(#?!\\) .*\\(\n\\)" (1 "<") (2 ">")) + ("\\_<\\(#?!\\)\\(\n\\)" (1 "<") (2 ">")) + ("\\_<\\(!(\\) .* \\()\\)" (1 "<") (2 ">")) ("\\(\\[\\)\\(let\\|wlet\\|let\\*\\)\\( \\|$\\)" (1 "(]")) ("\\(\\[\\)\\(|\\) +[^|]* \\(|\\)" (1 "(]") (2 "(|") (3 ")|")) (" \\(|\\) " (1 "(|")) (" \\(|\\)$" (1 ")")) - ("\\([[({]\\)\\([^ \"\n]\\)" (1 "_") (2 "_")) - ("\\([^ \"\n]\\)\\([])}]\\)" (1 "_") (2 "_")))) + ("CHAR: \\(\"\\)\\( \\|$\\)" (1 "w")) + (,(format "\\_<%s\\({\\)\\_>" (regexp-opt fuel-syntax--bracers)) (1 "(}")) + ("\\_<\\({\\)\\_>" (1 "(}")) + ("\\_<\\(}\\)\\_>" (1 "){")) + ("\\_<\\((\\)\\_>" (1 "()")) + ("\\_<\\()\\)\\_>" (1 ")(")) + ("\\_<\\(\\[\\)\\_>" (1 "(]")) + ("\\_<\\(\\]\\)\\_>" (1 ")[")))) ;;; Source code analysis: