Merge branch 'master' of git://factorcode.org/git/factor
John Benediktsson
commit
87a0bae8ef
|
|
@ -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
|
||||
; 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
|
||||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
|
|
|||
|
|
@ -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 ;
|
||||
|
|
@ -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 )
|
||||
|
|
|
|||
|
|
@ -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:
|
|||
|
||||
! !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
||||
|
||||
|
||||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)))))
|
||||
|
|
|
|||
|
|
@ -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 <jao@gnu.org>
|
||||
;; 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
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -105,6 +105,7 @@ buffer."
|
|||
|
||||
(defun fuel-listener-nuke ()
|
||||
(interactive)
|
||||
(comint-redirect-cleanup)
|
||||
(fuel-con--setup-connection fuel-listener--buffer))
|
||||
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -43,20 +43,26 @@
|
|||
;;; Regexps galore:
|
||||
|
||||
(defconst fuel-syntax--parsing-words
|
||||
'("{" "}" "^:" "^::" ";" "<<" "<PRIVATE" ">>"
|
||||
"BIN:" "BV{" "B{" "C:" "C-STRUCT:" "C-UNION:" "CHAR:" "CS{" "C{"
|
||||
'(":" "::" ";" "<<" "<PRIVATE" ">>"
|
||||
"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:
|
||||
|
|
|
|||
Loading…
Reference in New Issue