Merge branch 'emacs' of http://git.hacks-galore.org/jao/factor into faster_overflow_checks
Slava Pestov
commit
d3a40ff438
core/kernel
misc
|
|
@ -599,7 +599,7 @@ HELP: dip
|
|||
|
||||
HELP: 2dip
|
||||
{ $values { "x" object } { "y" object } { "quot" quotation } }
|
||||
{ $description "Calls " { $snippet "quot" } " with " { $snippet "obj1" } " and " { $snippet "obj2" } " hidden on the retain stack." }
|
||||
{ $description "Calls " { $snippet "quot" } " with " { $snippet "x" } " and " { $snippet "y" } " hidden on the retain stack." }
|
||||
{ $notes "The following are equivalent:"
|
||||
{ $code "[ [ foo bar ] dip ] dip" }
|
||||
{ $code "[ foo bar ] 2dip" }
|
||||
|
|
|
|||
158
misc/factor.el
158
misc/factor.el
|
|
@ -118,6 +118,10 @@ buffer."
|
|||
"Face for parsing words."
|
||||
:group 'factor-faces)
|
||||
|
||||
(defface factor-font-lock-declaration (face-default-spec font-lock-keyword-face)
|
||||
"Face for declaration words (inline, parsing ...)."
|
||||
:group 'factor-faces)
|
||||
|
||||
(defface factor-font-lock-comment (face-default-spec font-lock-comment-face)
|
||||
"Face for comments."
|
||||
:group 'factor-faces)
|
||||
|
|
@ -178,10 +182,15 @@ buffer."
|
|||
"UNION:" "USE:" "USING:" "V{" "VAR:" "VARS:" "W{"))
|
||||
|
||||
(defconst factor--regex-parsing-words-ext
|
||||
(regexp-opt '("B" "call-next-method" "delimiter" "f" "flushable" "foldable"
|
||||
"initial:" "inline" "parsing" "read-only" "recursive")
|
||||
(regexp-opt '("B" "call-next-method" "delimiter" "f" "initial:" "read-only")
|
||||
'words))
|
||||
|
||||
(defconst factor--declaration-words
|
||||
'("flushable" "foldable" "inline" "parsing" "recursive"))
|
||||
|
||||
(defconst factor--regex-declaration-words
|
||||
(regexp-opt factor--declaration-words 'words))
|
||||
|
||||
(defsubst factor--regex-second-word (prefixes)
|
||||
(format "^%s +\\([^ \r\n]+\\)" (regexp-opt prefixes t)))
|
||||
|
||||
|
|
@ -202,7 +211,7 @@ buffer."
|
|||
|
||||
(defconst factor--regex-stack-effect " ( .* )")
|
||||
|
||||
(defconst factor--regex-using-line "^USING: +\\([^;]*\\);")
|
||||
(defconst factor--regex-using-lines "^USING: +\\(\\([^;]\\|[\n\r\f]\\)*\\);")
|
||||
|
||||
(defconst factor--regex-use-line "^USE: +\\(.*\\)$")
|
||||
|
||||
|
|
@ -213,30 +222,31 @@ buffer."
|
|||
'(2 'factor-font-lock-parsing-word)))
|
||||
factor--parsing-words)
|
||||
(,factor--regex-parsing-words-ext . 'factor-font-lock-parsing-word)
|
||||
(,factor--regex-declaration-words 1 'factor-font-lock-declaration)
|
||||
(,factor--regex-word-definition 2 'factor-font-lock-word-definition)
|
||||
(,factor--regex-type-definition 2 'factor-font-lock-type-definition)
|
||||
(,factor--regex-parent-type 1 'factor-font-lock-type-definition)
|
||||
(,factor--regex-constructor . 'factor-font-lock-constructor)
|
||||
(,factor--regex-setter . 'factor-font-lock-setter-word)
|
||||
(,factor--regex-symbol-definition 2 'factor-font-lock-symbol-definition)
|
||||
(,factor--regex-using-line 1 'factor-font-lock-vocabulary-name)
|
||||
(,factor--regex-using-lines 1 'factor-font-lock-vocabulary-name)
|
||||
(,factor--regex-use-line 1 'factor-font-lock-vocabulary-name))
|
||||
"Font lock keywords definition for Factor mode.")
|
||||
|
||||
|
||||
;;; Factor mode syntax:
|
||||
|
||||
(defconst factor--regexp-word-starters
|
||||
(defconst factor--regex-definition-starters
|
||||
(regexp-opt '("TUPLE" "MACRO" "MACRO:" "M" ":" "")))
|
||||
|
||||
(defconst factor--regexp-word-start
|
||||
(format "^\\(%s:\\) " factor--regexp-word-starters))
|
||||
(defconst factor--regex-definition-start
|
||||
(format "^\\(%s:\\) " factor--regex-definition-starters))
|
||||
|
||||
(defconst factor--regex-definition-end
|
||||
(format "\\(;\\( +%s\\)*\\)" factor--regex-declaration-words))
|
||||
|
||||
(defconst factor--font-lock-syntactic-keywords
|
||||
`((,(format "^\\(%s\\)\\(:\\)" factor--regexp-word-starters)
|
||||
(1 "w") (2 "(;"))
|
||||
("\\(;\\)" (1 "):"))
|
||||
("\\(#!\\)" (1 "<"))
|
||||
`(("\\(#!\\)" (1 "<"))
|
||||
(" \\(!\\)" (1 "<"))
|
||||
("^\\(!\\)" (1 "<"))
|
||||
("\\(!(\\) .* \\()\\)" (1 "<") (2 ">"))))
|
||||
|
|
@ -290,6 +300,7 @@ buffer."
|
|||
(modify-syntax-entry ?\" "\"" factor-mode-syntax-table)
|
||||
(modify-syntax-entry ?\\ "/" factor-mode-syntax-table)))
|
||||
|
||||
|
||||
;;; symbol-at-point
|
||||
|
||||
(defun factor--beginning-of-symbol ()
|
||||
|
|
@ -323,7 +334,7 @@ buffer."
|
|||
(save-excursion
|
||||
(beginning-of-buffer)
|
||||
(while (not iw)
|
||||
(if (not (re-search-forward factor--regexp-word-start nil t))
|
||||
(if (not (re-search-forward factor--regex-definition-start nil t))
|
||||
(setq iw factor-default-indent-width)
|
||||
(forward-line)
|
||||
(when (looking-at word-cont)
|
||||
|
|
@ -336,13 +347,17 @@ buffer."
|
|||
(defsubst factor--ppss-brackets-start ()
|
||||
(nth 1 (syntax-ppss)))
|
||||
|
||||
(defun factor--ppss-brackets-end ()
|
||||
(save-excursion
|
||||
(goto-char (factor--ppss-brackets-start))
|
||||
(condition-case nil
|
||||
(progn (forward-sexp)
|
||||
(1- (point)))
|
||||
(error -1))))
|
||||
|
||||
(defsubst factor--indentation-at (pos)
|
||||
(save-excursion (goto-char pos) (current-indentation)))
|
||||
|
||||
(defconst factor--regex-closing-paren "[])}]")
|
||||
(defsubst factor--at-closing-paren-p ()
|
||||
(looking-at factor--regex-closing-paren))
|
||||
|
||||
(defsubst factor--at-first-char-p ()
|
||||
(= (- (point) (line-beginning-position)) (current-indentation)))
|
||||
|
||||
|
|
@ -350,16 +365,28 @@ buffer."
|
|||
(format "^%s" (regexp-opt '("DEFER:" "GENERIC:" "IN:"
|
||||
"PRIVATE>" "<PRIVATE" "SYMBOL:" "USE:"))))
|
||||
|
||||
(defconst factor--regex-begin-of-def
|
||||
(format "^USING: \\|\\(%s\\)\\|\\(%s .*\\)"
|
||||
factor--regex-definition-start
|
||||
factor--regex-single-liner))
|
||||
|
||||
(defconst factor--regex-end-of-def-line
|
||||
(format "^.*%s" factor--regex-definition-end))
|
||||
|
||||
(defconst factor--regex-end-of-def
|
||||
(format "\\(%s\\)\\|\\(%s .*\\)"
|
||||
factor--regex-end-of-def-line
|
||||
factor--regex-single-liner))
|
||||
|
||||
(defsubst factor--at-begin-of-def ()
|
||||
(looking-at factor--regexp-word-start))
|
||||
(looking-at factor--regex-begin-of-def))
|
||||
|
||||
(defsubst factor--at-end-of-def ()
|
||||
(looking-at factor--regex-end-of-def))
|
||||
|
||||
(defsubst factor--looking-at-emptiness ()
|
||||
(looking-at "^[ \t]*$"))
|
||||
|
||||
(defun factor--at-end-of-def ()
|
||||
(or (looking-at ".*;[ \t]*$")
|
||||
(looking-at factor--regex-single-liner)))
|
||||
|
||||
(defun factor--at-setter-line ()
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
|
|
@ -382,13 +409,12 @@ buffer."
|
|||
(defun factor--indent-in-brackets ()
|
||||
(save-excursion
|
||||
(beginning-of-line)
|
||||
(when (or (and (re-search-forward factor--regex-closing-paren
|
||||
(line-end-position) t)
|
||||
(not (backward-char)))
|
||||
(> (factor--ppss-brackets-depth) 0))
|
||||
(let ((op (factor--ppss-brackets-start)))
|
||||
(when (> (line-number-at-pos) (line-number-at-pos op))
|
||||
(if (factor--at-closing-paren-p)
|
||||
(when (> (factor--ppss-brackets-depth) 0)
|
||||
(let ((op (factor--ppss-brackets-start))
|
||||
(cl (factor--ppss-brackets-end))
|
||||
(ln (line-number-at-pos)))
|
||||
(when (> ln (line-number-at-pos op))
|
||||
(if (and (> cl 0) (= ln (line-number-at-pos cl)))
|
||||
(factor--indentation-at op)
|
||||
(factor--increased-indentation (factor--indentation-at op))))))))
|
||||
|
||||
|
|
@ -417,7 +443,8 @@ buffer."
|
|||
(forward-line -1))
|
||||
(if (or (factor--at-end-of-def) (factor--at-setter-line))
|
||||
(factor--decreased-indentation)
|
||||
(if (factor--at-begin-of-def)
|
||||
(if (and (factor--at-begin-of-def)
|
||||
(not (looking-at factor--regex-using-lines)))
|
||||
(factor--increased-indentation)
|
||||
(current-indentation)))))
|
||||
|
||||
|
|
@ -448,6 +475,12 @@ buffer."
|
|||
(defvar factor-mode-map (make-sparse-keymap)
|
||||
"Key map used by Factor mode.")
|
||||
|
||||
(defsubst factor--beginning-of-defun (times)
|
||||
(re-search-backward factor--regex-begin-of-def nil t times))
|
||||
|
||||
(defsubst factor--end-of-defun ()
|
||||
(re-search-forward factor--regex-end-of-def nil t))
|
||||
|
||||
;;;###autoload
|
||||
(defun factor-mode ()
|
||||
"A mode for editing programs written in the Factor programming language.
|
||||
|
|
@ -469,8 +502,9 @@ buffer."
|
|||
|
||||
(set-syntax-table factor-mode-syntax-table)
|
||||
;; Defun navigation
|
||||
(setq defun-prompt-regexp "[^ :]+")
|
||||
(set (make-local-variable 'open-paren-in-column-0-is-defun-start) t)
|
||||
(set (make-local-variable 'beginning-of-defun-function) 'factor--beginning-of-defun)
|
||||
(set (make-local-variable 'end-of-defun-function) 'factor--end-of-defun)
|
||||
(set (make-local-variable 'open-paren-in-column-0-is-defun-start) nil)
|
||||
;; Indentation
|
||||
(set (make-local-variable 'indent-line-function) 'factor--indent-line)
|
||||
(setq factor-indent-width (factor--guess-indent-width))
|
||||
|
|
@ -506,7 +540,8 @@ buffer."
|
|||
(defun factor--listener-process (&optional start)
|
||||
(or (and (buffer-live-p factor--listener-buffer)
|
||||
(get-buffer-process factor--listener-buffer))
|
||||
(when start
|
||||
(if (not start)
|
||||
(error "No running factor listener. Try M-x run-factor.")
|
||||
(factor--listener-start-process)
|
||||
(factor--listener-process t))))
|
||||
|
||||
|
|
@ -566,7 +601,6 @@ buffer."
|
|||
(defun factor--current-listener-vocab ()
|
||||
(car (factor--listener-send-cmd "USING: parser ; in get .")))
|
||||
|
||||
|
||||
(defun factor--set-current-listener-vocab (&optional vocab)
|
||||
(factor--listener-send-cmd
|
||||
(format "IN: %s" (or vocab (factor--current-buffer-vocab))))
|
||||
|
|
@ -596,23 +630,28 @@ buffer."
|
|||
(defconst factor--regex-error-marker "^Type :help for debugging")
|
||||
(defconst factor--regex-data-stack "^--- Data stack:")
|
||||
|
||||
(defun factor--prune-stack (ans)
|
||||
(do ((res '() (cons (car s) res)) (s ans (cdr s)))
|
||||
((or (not s)
|
||||
(and (car res) (string-match factor--regex-stack-effect (car res)))
|
||||
(string-match factor--regex-data-stack (car s)))
|
||||
(and (not (string-match factor--regex-error-marker (car res)))
|
||||
(nreverse res)))))
|
||||
(defun factor--prune-ans-strings (ans)
|
||||
(nreverse
|
||||
(catch 'done
|
||||
(let ((res))
|
||||
(dolist (a ans res)
|
||||
(cond ((string-match factor--regex-stack-effect a)
|
||||
(throw 'done (cons a res)))
|
||||
((string-match factor--regex-data-stack a)
|
||||
(throw 'done res))
|
||||
((string-match factor--regex-error-marker a)
|
||||
(throw 'done nil))
|
||||
(t (push a res))))))))
|
||||
|
||||
(defun factor--see-ans-to-string (ans)
|
||||
(let ((s (mapconcat #'identity (factor--prune-stack ans) " ")))
|
||||
(let ((s (mapconcat #'identity (factor--prune-ans-strings ans) " "))
|
||||
(font-lock-verbose nil))
|
||||
(and (> (length s) 0)
|
||||
(let ((font-lock-verbose nil))
|
||||
(with-temp-buffer
|
||||
(insert s)
|
||||
(factor-mode)
|
||||
(font-lock-fontify-buffer)
|
||||
(buffer-string))))))
|
||||
(with-temp-buffer
|
||||
(insert s)
|
||||
(factor-mode)
|
||||
(font-lock-fontify-buffer)
|
||||
(buffer-string)))))
|
||||
|
||||
(defun factor--see-current-word (&optional word)
|
||||
(let ((word (or word (factor--symbol-at-point))))
|
||||
|
|
@ -625,10 +664,9 @@ buffer."
|
|||
(defun factor-see-current-word (&optional word)
|
||||
"Echo in the minibuffer information about word at point."
|
||||
(interactive)
|
||||
(unless (factor--listener-process)
|
||||
(error "No factor listener running. Try M-x run-factor"))
|
||||
(let ((word (or word (factor--symbol-at-point)))
|
||||
(msg (factor--see-current-word word)))
|
||||
(let* ((proc (factor--listener-process))
|
||||
(word (or word (factor--symbol-at-point)))
|
||||
(msg (factor--see-current-word word)))
|
||||
(if msg (message "%s" msg)
|
||||
(if word (message "No help found for '%s'" word)
|
||||
(message "No word at point")))))
|
||||
|
|
@ -746,9 +784,8 @@ buffer."
|
|||
(defvar factor--help-history nil)
|
||||
|
||||
(defun factor--listener-show-help (&optional see)
|
||||
(unless (factor--listener-process)
|
||||
(error "No running factor listener. Try M-x run-factor"))
|
||||
(let* ((def (factor--symbol-at-point))
|
||||
(let* ((proc (factor--listener-process))
|
||||
(def (factor--symbol-at-point))
|
||||
(prompt (format "See%s help on%s: " (if see " short" "")
|
||||
(if def (format " (%s)" def) "")))
|
||||
(ask (or (not (eq major-mode 'factor-mode))
|
||||
|
|
@ -757,8 +794,7 @@ buffer."
|
|||
(cmd (format "\\ %s %s"
|
||||
(if ask (read-string prompt nil 'factor--help-history def) def)
|
||||
(if see "see" "help")))
|
||||
(hb (factor--listener-help-buffer))
|
||||
(proc (factor--listener-process)))
|
||||
(hb (factor--listener-help-buffer)))
|
||||
(comint-redirect-send-command-to-process cmd hb proc nil)
|
||||
(pop-to-buffer hb)
|
||||
(beginning-of-buffer hb)))
|
||||
|
|
@ -799,6 +835,13 @@ vocabularies which have been modified on disk."
|
|||
(define-key m (vector '(control ?c) key) cmd)
|
||||
(define-key m (vector '(control ?c) `(control ,key)) cmd))))
|
||||
|
||||
(defun factor--define-auto-indent-key (key)
|
||||
(define-key factor-mode-map (vector key)
|
||||
(lambda (n)
|
||||
(interactive "p")
|
||||
(self-insert-command n)
|
||||
(indent-for-tab-command))))
|
||||
|
||||
(factor--define-key ?f 'factor-run-file)
|
||||
(factor--define-key ?r 'factor-send-region)
|
||||
(factor--define-key ?d 'factor-send-definition)
|
||||
|
|
@ -807,6 +850,9 @@ vocabularies which have been modified on disk."
|
|||
(factor--define-key ?z 'switch-to-factor t)
|
||||
(factor--define-key ?c 'comment-region)
|
||||
|
||||
(factor--define-auto-indent-key ?\])
|
||||
(factor--define-auto-indent-key ?\})
|
||||
|
||||
(define-key factor-mode-map "\C-ch" 'factor-help)
|
||||
(define-key factor-help-mode-map "\C-ch" 'factor-help)
|
||||
(define-key factor-mode-map "\C-m" 'newline-and-indent)
|
||||
|
|
|
|||
Loading…
Reference in New Issue