From 4c1e23b82d59e26fc22f6b115b32d8aee79c3e87 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Fri, 28 Nov 2008 13:23:15 +0100
Subject: [PATCH 1/6] Emacs factor mode: bug fix: don't depend on cl's DO.
---
misc/factor.el | 33 +++++++++++++++++++--------------
1 file changed, 19 insertions(+), 14 deletions(-)
diff --git a/misc/factor.el b/misc/factor.el
index 998261e4e6..ba1c633466 100644
--- a/misc/factor.el
+++ b/misc/factor.el
@@ -596,23 +596,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))))
From cb815a965b35890e475057314381e6fb3e0f054d Mon Sep 17 00:00:00 2001
From: Eduardo Cavazos <dharmatech@finkelstein.stackeffects.info>
Date: Fri, 28 Nov 2008 12:33:42 -0600
Subject: [PATCH 2/6] kernel-docs: Fix '2dip' docs
---
core/kernel/kernel-docs.factor | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/core/kernel/kernel-docs.factor b/core/kernel/kernel-docs.factor
index e1fa0f6fa3..3fc3d175a0 100644
--- a/core/kernel/kernel-docs.factor
+++ b/core/kernel/kernel-docs.factor
@@ -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" }
From bc5c6d85c414f5233db83d75edf5051ab69ceae4 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Fri, 28 Nov 2008 22:51:36 +0100
Subject: [PATCH 3/6] Emacs factor mode: fix indentation in presence of
declaration word, and add a face for them.
---
misc/factor.el | 71 ++++++++++++++++++++++++++++++++------------------
1 file changed, 45 insertions(+), 26 deletions(-)
diff --git a/misc/factor.el b/misc/factor.el
index ba1c633466..19f8385e34 100644
--- a/misc/factor.el
+++ b/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)))
@@ -213,6 +222,7 @@ 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)
@@ -226,17 +236,17 @@ buffer."
;;; 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 ">"))))
@@ -323,7 +333,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 +346,15 @@ buffer."
(defsubst factor--ppss-brackets-start ()
(nth 1 (syntax-ppss)))
+(defun factor--ppss-brackets-end ()
+ (save-excursion
+ (goto-char (factor--ppss-brackets-start))
+ (forward-sexp)
+ (1- (point))))
+
(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)))
@@ -351,13 +363,14 @@ buffer."
"PRIVATE>" "<PRIVATE" "SYMBOL:" "USE:"))))
(defsubst factor--at-begin-of-def ()
- (looking-at factor--regexp-word-start))
+ (or (looking-at factor--regex-definition-start)
+ (looking-at factor--regex-single-liner)))
(defsubst factor--looking-at-emptiness ()
(looking-at "^[ \t]*$"))
-(defun factor--at-end-of-def ()
- (or (looking-at ".*;[ \t]*$")
+(defsubst factor--at-end-of-def ()
+ (or (looking-at factor--regex-definition-end)
(looking-at factor--regex-single-liner)))
(defun factor--at-setter-line ()
@@ -382,13 +395,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 (= ln (line-number-at-pos cl))
(factor--indentation-at op)
(factor--increased-indentation (factor--indentation-at op))))))))
@@ -448,6 +460,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-definition-start nil t times))
+
+(defsubst factor--end-of-defun ()
+ (re-search-forward factor--regex-definition-end nil t))
+
;;;###autoload
(defun factor-mode ()
"A mode for editing programs written in the Factor programming language.
@@ -469,8 +487,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))
From 858f848441cc2ad2070593fda6bd6c06b21ca74d Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Sat, 29 Nov 2008 01:55:08 +0100
Subject: [PATCH 4/6] Emacs factor mode: electric ] and }; another fix for
declaration-aware indentation.
---
misc/factor.el | 23 +++++++++++++++++++----
1 file changed, 19 insertions(+), 4 deletions(-)
diff --git a/misc/factor.el b/misc/factor.el
index 19f8385e34..5313387a6a 100644
--- a/misc/factor.el
+++ b/misc/factor.el
@@ -349,8 +349,10 @@ buffer."
(defun factor--ppss-brackets-end ()
(save-excursion
(goto-char (factor--ppss-brackets-start))
- (forward-sexp)
- (1- (point))))
+ (condition-case nil
+ (progn (forward-sexp)
+ (1- (point)))
+ (error -1)))))
(defsubst factor--indentation-at (pos)
(save-excursion (goto-char pos) (current-indentation)))
@@ -369,8 +371,11 @@ buffer."
(defsubst factor--looking-at-emptiness ()
(looking-at "^[ \t]*$"))
+(defconst factor--regex-end-of-def-line
+ (format "^.*%s" factor--regex-definition-end))
+
(defsubst factor--at-end-of-def ()
- (or (looking-at factor--regex-definition-end)
+ (or (looking-at factor--regex-end-of-def-line)
(looking-at factor--regex-single-liner)))
(defun factor--at-setter-line ()
@@ -400,7 +405,7 @@ buffer."
(cl (factor--ppss-brackets-end))
(ln (line-number-at-pos)))
(when (> ln (line-number-at-pos op))
- (if (= ln (line-number-at-pos cl))
+ (if (and (> cl 0) (= ln (line-number-at-pos cl)))
(factor--indentation-at op)
(factor--increased-indentation (factor--indentation-at op))))))))
@@ -823,6 +828,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)
@@ -831,6 +843,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)
From 2810b9ac0f29caaec096a248e138c1ce212a9555 Mon Sep 17 00:00:00 2001
From: "Jose A. Ortega Ruiz" <jao@gnu.org>
Date: Sat, 29 Nov 2008 01:58:20 +0100
Subject: [PATCH 5/6] Emacs factor: Oops, fix previous commit.
---
misc/factor.el | 2 +-
1 file changed, 1 insertion(+), 1 deletion(-)
diff --git a/misc/factor.el b/misc/factor.el
index 5313387a6a..ff398b1bf4 100644
--- a/misc/factor.el
+++ b/misc/factor.el
@@ -352,7 +352,7 @@ buffer."
(condition-case nil
(progn (forward-sexp)
(1- (point)))
- (error -1)))))
+ (error -1))))
(defsubst factor--indentation-at (pos)
(save-excursion (goto-char pos) (current-indentation)))
From 14c096dd822b0dd859218030369f5e6e692ca56e Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Thu, 20 Nov 2008 15:23:02 -0600
Subject: [PATCH 6/6] fix mouse scrolling on windows
---
basis/ui/windows/windows.factor | 6 +++---
1 file changed, 3 insertions(+), 3 deletions(-)
diff --git a/basis/ui/windows/windows.factor b/basis/ui/windows/windows.factor
index 3805cf7e1f..6e1ce8f77f 100755
--- a/basis/ui/windows/windows.factor
+++ b/basis/ui/windows/windows.factor
@@ -285,7 +285,7 @@ SYMBOL: nc-buttons
swap [ push ] [ delete ] if ;
: >lo-hi ( WORD -- array ) [ lo-word ] keep hi-word 2array ;
-: mouse-wheel ( lParam -- array ) >lo-hi [ sgn neg ] map ;
+: mouse-wheel ( wParam -- array ) >lo-hi [ sgn neg ] map ;
: mouse-absolute>relative ( lparam handle -- array )
[ >lo-hi ] dip
@@ -338,8 +338,8 @@ SYMBOL: nc-buttons
>lo-hi swap window move-hand fire-motion ;
:: handle-wm-mousewheel ( hWnd uMsg wParam lParam -- )
- lParam mouse-wheel
- hWnd mouse-absolute>relative
+ wParam mouse-wheel
+ lParam hWnd mouse-absolute>relative
hWnd window send-wheel ;
: handle-wm-cancelmode ( hWnd uMsg wParam lParam -- )