[MLton-commit] r5308

[Vesa Karvonen]

Yet more refined symbol picking.
----------------------------------------------------------------------

U   mlton/trunk/ide/emacs/esml-du-mlton.el
U   mlton/trunk/ide/emacs/esml-util.el

----------------------------------------------------------------------

Modified: mlton/trunk/ide/emacs/esml-du-mlton.el
===================================================================
--- mlton/trunk/ide/emacs/esml-du-mlton.el	2007-02-25 13:18:37 UTC (rev 5307)
+++ mlton/trunk/ide/emacs/esml-du-mlton.el	2007-02-25 14:46:08 UTC (rev 5308)
@@ -76,24 +76,34 @@
    ((find c esml-sml-alphanumeric-chars)
     'alphanumeric)))
 
+(defun esml-du-extract-following-symbol (chars)
+  (save-excursion
+    (let ((start (point)))
+      (skip-chars-forward chars)
+      (buffer-substring start (point)))))
+
 (defun esml-du-move-to-symbol-start ()
   "Moves to the start of the SML symbol at point.  If the point is between
 two symbols, one symbolic and other alphanumeric (e.g. !x) the symbol
 following the point is preferred.  This ensures that the symbol does not
 change surprisingly after a jump."
-  (let ((limit (def-use-point-at-current-line)))
-    (let ((bef (esml-du-character-class (char-before)))
-          (aft (esml-du-character-class (char-after)))
-          (fol (esml-du-character-class (char-after (1+ (point))))))
-      (cond
-       ((and (eq bef 'alphanumeric)
-             (equal ?= (char-after))
-             (not (eq fol 'symbolic)))
-        (skip-chars-backward esml-sml-alphanumeric-chars limit))
-       ((and (eq bef 'symbolic) (not (eq aft 'alphanumeric)))
-        (skip-chars-backward esml-sml-symbolic-chars limit))
-       ((and (eq bef 'alphanumeric) (not (eq aft 'symbolic)))
-        (skip-chars-backward esml-sml-alphanumeric-chars limit))))))
+  (let ((bef (esml-du-character-class (char-before)))
+        (aft (esml-du-character-class (char-after))))
+    (cond
+     ((and (eq bef 'alphanumeric) (eq aft 'symbolic)
+           (find (esml-du-extract-following-symbol esml-sml-symbolic-chars)
+                 esml-sml-symbolic-keywords
+                 :test 'equal))
+      (skip-chars-backward esml-sml-alphanumeric-chars))
+     ((and (eq bef 'symbolic) (eq aft 'alphanumeric)
+           (find (esml-du-extract-following-symbol esml-sml-alphanumeric-chars)
+                 esml-sml-alphanumeric-keywords
+                 :test 'equal))
+      (skip-chars-backward esml-sml-symbolic-chars))
+     ((and (eq bef 'symbolic) (not (eq aft 'alphanumeric)))
+      (skip-chars-backward esml-sml-symbolic-chars))
+     ((and (eq bef 'alphanumeric) (not (eq aft 'symbolic)))
+      (skip-chars-backward esml-sml-alphanumeric-chars)))))
 
 (add-to-list 'def-use-mode-to-move-to-symbol-start-alist
              (cons 'sml-mode (function esml-du-move-to-symbol-start)))

Modified: mlton/trunk/ide/emacs/esml-util.el
===================================================================
--- mlton/trunk/ide/emacs/esml-util.el	2007-02-25 13:18:37 UTC (rev 5307)
+++ mlton/trunk/ide/emacs/esml-util.el	2007-02-25 14:46:08 UTC (rev 5308)
@@ -17,6 +17,20 @@
   "A string of all Standard ML alphanumeric characters as defined in
 section 2.4 of the Definition.")
 
+(defconst esml-sml-symbolic-keywords '("#" "*" "->" ":" "::" ":>" "=" "=>" "|")
+  "A list of symbolic keywords or reserved words as defined in sections
+2.1 and section 3.1 and including the special symbol * mentioned in 2.4 as
+well as the symbol :: mentioned in section 2.9 of the Definition.")
+
+(defconst esml-sml-alphanumeric-keywords
+  '("_" "abstype" "and" "andalso" "as" "case" "datatype" "do" "else" "end"
+    "eqtype" "exception" "false" "fn" "fun" "functor" "handle" "if" "in"
+    "include" "infix" "infixr" "let" "local" "nil" "nonfix" "of" "op" "open"
+    "orelse" "raise" "rec" "ref" "sharing" "sig" "signature" "struct"
+    "structure" "then" "true" "type" "val" "where" "while" "with" "withtype")
+  "A list of alphanumeric keywords or reserved words as well as
+non-bindable identifiers defined in various sections of the Definition")
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Some general purpose Emacs Lisp utility functions