[MLton-commit] r6113

[Vesa Karvonen]

Support for showing "messages" (e.g. types of variables) attached to
definitions in def-use info.

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

U   mlton/trunk/ide/emacs/def-use-data.el
U   mlton/trunk/ide/emacs/def-use-mode.el
U   mlton/trunk/ide/emacs/esml-du-mlton.el

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

Modified: mlton/trunk/ide/emacs/def-use-data.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-data.el	2007-11-02 09:03:57 UTC (rev 6112)
+++ mlton/trunk/ide/emacs/def-use-data.el	2007-11-02 11:39:12 UTC (rev 6113)
@@ -24,10 +24,11 @@
       (and (equal (def-use-ref-src lhs) (def-use-ref-src rhs))
            (def-use-pos< (def-use-ref-pos lhs) (def-use-ref-pos rhs)))))
 
-(defun def-use-sym (class name ref &optional face)
+(defun def-use-sym (class msg name ref &optional face)
   "Symbol constructor."
-  (cons ref (cons name (cons class face))))
-(defalias 'def-use-sym-face (function cdddr))
+  (cons ref (cons name (cons class (cons msg face)))))
+(defalias 'def-use-sym-face (function cddddr))
+(defalias 'def-use-sym-msg (function cadddr))
 (defalias 'def-use-sym-class (function caddr))
 (defalias 'def-use-sym-name (function cadr))
 (defalias 'def-use-sym-ref (function car))

Modified: mlton/trunk/ide/emacs/def-use-mode.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-mode.el	2007-11-02 09:03:57 UTC (rev 6112)
+++ mlton/trunk/ide/emacs/def-use-mode.el	2007-11-02 11:39:12 UTC (rev 6113)
@@ -88,13 +88,21 @@
   :set (function def-use-set-custom-and-update)
   :group 'def-use)
 
+(defcustom def-use-auto-show-symbol-messages t
+  "Whether to show messages attached to symbols implicitly."
+  :type '(choice
+          (const :tag "disable" nil)
+          (const :tag "enable" t))
+  :group 'def-use)
+
 (defcustom def-use-key-bindings
   '(("[(control c) (control d)]" . def-use-jump-to-def)
+    ("[(control c) (control l)]" . def-use-list-all-refs)
+    ("[(control c) (control m)]" . def-use-pop-ref-mark)
     ("[(control c) (control n)]" . def-use-jump-to-next)
     ("[(control c) (control p)]" . def-use-jump-to-prev)
-    ("[(control c) (control m)]" . def-use-pop-ref-mark)
     ("[(control c) (control s)]" . def-use-show-dus)
-    ("[(control c) (control l)]" . def-use-list-all-refs)
+    ("[(control c) (control t)]" . def-use-show-msg)
     ("[(control c) (control v)]" . def-use-show-info))
   "Key bindings for the def-use mode.  The key specifications must be
 in a format accepted by the function `define-key'.  Hint: You might
@@ -365,6 +373,14 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Info
 
+(defun def-use-show-msg ()
+  "Shows the message for the symbol under the cursor."
+  (interactive)
+  (let ((sym (def-use-current-sym)))
+    (when sym
+      (message "%s" (or (def-use-sym-msg sym)
+                        "Sorry, no message attached to the symbol.")))))
+
 (defun def-use-show-info ()
   "Shows info on the symbol under the cursor."
   (interactive)
@@ -386,7 +402,10 @@
             (copy-sequence (def-use-sym-class sym)))
           " "
           (def-use-add-face (def-use-sym-face sym)
-            (copy-sequence (def-use-sym-name sym)))))
+            (copy-sequence (def-use-sym-name sym)))
+          (if (def-use-sym-msg sym)
+              (concat " : " (def-use-sym-msg sym))
+            "")))
 
 (defun def-use-format-ref (ref)
   "Formats a references."
@@ -460,7 +479,11 @@
                 length (def-use-ref-pos ref)
                 (if (def-use-sym-to-uses sym)
                     'def-use-def-face
-                  'def-use-unused-def-face)))))))))
+                  'def-use-unused-def-face)))))
+        (when def-use-auto-show-symbol-messages
+          (let ((msg (def-use-sym-msg sym)))
+            (when msg
+              (message "%s" msg))))))))
 
 (defun def-use-highlight-current ()
   "Highlights the symbol at the point."

Modified: mlton/trunk/ide/emacs/esml-du-mlton.el
===================================================================
--- mlton/trunk/ide/emacs/esml-du-mlton.el	2007-11-02 09:03:57 UTC (rev 6112)
+++ mlton/trunk/ide/emacs/esml-du-mlton.el	2007-11-02 11:39:12 UTC (rev 6113)
@@ -289,6 +289,11 @@
       (skip-chars-forward skipping)
       result)))
 
+(defun esml-du-read-opt-str ()
+  (when (= (char-after) ?\")
+    (forward-char 1)
+    (esml-du-read "^\"" "\"")))
+
 (defconst esml-du-classes ;; XXX Needs customization
   `((,(def-use-intern "variable")    . ,font-lock-variable-name-face)
     (,(def-use-intern "type")        . ,font-lock-variable-name-face)
@@ -357,16 +362,18 @@
          (name (def-use-intern (esml-du-read "^ " " ")))
          (src (def-use-file-truename (esml-du-read "^ " " ")))
          (line (string-to-int (esml-du-read "^." ".")))
-         (col (1- (string-to-int (esml-du-read "^\n" "\n"))))
+         (col (1- (string-to-int (esml-du-read "^ \n" " "))))
+         (msg (def-use-intern (esml-du-read-opt-str)))
          (pos (def-use-pos line col))
          (ref (def-use-ref src pos))
-         (sym (def-use-sym class name ref
+         (sym (def-use-sym class msg name ref
                 (cdr (assoc class esml-du-classes))))
          (uses nil))
     (let ((old-sym (gethash ref ref-to-sym)))
       (when old-sym
         (setq sym old-sym))
       (puthash ref sym ref-to-sym))
+    (skip-chars-forward "\n")
     (while (< 0 (skip-chars-forward " "))
       (let* ((src (def-use-file-truename (esml-du-read "^ " " ")))
              (line (string-to-int (esml-du-read "^." ".")))