[MLton-commit] r5757

Vesa Karvonen vesak at mlton.org
Wed Jul 11 04:13:59 PDT 2007


Print out a guess on why there is no info on the queried symbol.
----------------------------------------------------------------------

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-07-11 10:15:45 UTC (rev 5756)
+++ mlton/trunk/ide/emacs/def-use-data.el	2007-07-11 11:13:58 UTC (rev 5757)
@@ -35,8 +35,8 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Def-use sources
 
-(defun def-use-add-dus (title sym-at-ref sym-to-uses finalize &rest args)
-  (push (cons args (cons sym-at-ref (cons sym-to-uses (cons title finalize))))
+(defun def-use-add-dus (title sym-at-ref sym-to-uses finalize attr &rest args)
+  (push (cons args (cons sym-at-ref (cons sym-to-uses (cons attr (cons title finalize)))))
         def-use-dus-list)
   (def-use-show-dus-update))
 
@@ -52,11 +52,14 @@
 (defun def-use-dus-sym-to-uses (dus sym)
   (apply (caddr dus) sym (car dus)))
 
-(defun def-use-dus-title (dus)
+(defun def-use-dus-attr (dus)
   (apply (cadddr dus) (car dus)))
 
+(defun def-use-dus-title (dus)
+  (apply (cadddr (cdr dus)) (car dus)))
+
 (defun def-use-dus-finalize (dus)
-  (apply (cddddr dus) (car dus)))
+  (apply (cddddr (cdr dus)) (car dus)))
 
 (defvar def-use-dus-list nil)
 
@@ -121,6 +124,11 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Queries
 
+(defun def-use-attrs ()
+  (sort (mapcar (function def-use-dus-attr)
+                def-use-dus-list)
+        (function def-use-attr-newer?)))
+
 (defun def-use-query (fn)
   "Queries the def-use -sources with the given function and moves the
 satisfied dus to the front."
@@ -138,12 +146,30 @@
       (def-use-show-dus-update))
     result))
 
-(defun def-use-sym-at-ref (ref)
-  (when ref
-    (def-use-query
-      (function
-       (lambda (dus)
-         (def-use-dus-sym-at-ref dus ref))))))
+(defun def-use-sym-at-ref (ref &optional no-apology)
+  (let ((result
+         (when ref
+           (def-use-query
+             (function
+              (lambda (dus)
+                (def-use-dus-sym-at-ref dus ref)))))))
+    (unless (or result no-apology)
+      (let* ((attrs (def-use-attrs))
+             (file (def-use-ref-src ref))
+             (attr (file-attributes file))
+             (buffer (def-use-find-buffer-visiting-file file)))
+        (message
+         "Sorry, no info on the symbol.  Probable reason:  %s"
+         (cond
+          ((not attrs)
+           "There are no def-use sources.")
+          ((def-use-attr-newer? attr (car attrs))
+           "The file is newer than any def-use source.")
+          ((buffer-modified-p buffer)
+           "The buffer has been modified.")
+          (t
+           "The symbol may not be in any def-use source.")))))
+    result))
 
 (defun def-use-sym-to-uses (sym)
   (when sym

Modified: mlton/trunk/ide/emacs/def-use-mode.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-mode.el	2007-07-11 10:15:45 UTC (rev 5756)
+++ mlton/trunk/ide/emacs/def-use-mode.el	2007-07-11 11:13:58 UTC (rev 5757)
@@ -172,19 +172,19 @@
            (end (progn (def-use-move-to-symbol-end) (point))))
       (buffer-substring start end))))
 
-(defun def-use-sym-at-point (point)
+(defun def-use-sym-at-point (point &optional no-apology)
   "Returns symbol information for the symbol at the specified point."
   (let ((ref (def-use-ref-at-point point)))
     (when ref
-      (let ((sym (def-use-sym-at-ref ref)))
+      (let ((sym (def-use-sym-at-ref ref no-apology)))
         (when (and sym
                    (string= (def-use-sym-name sym)
                             (def-use-extract-sym-name-at-point point)))
           sym)))))
 
-(defun def-use-current-sym ()
+(defun def-use-current-sym (&optional no-apology)
   "Returns symbol information for the symbol at the current point."
-  (def-use-sym-at-point (point)))
+  (def-use-sym-at-point (point) no-apology))
 
 (defun def-use-current-ref ()
   "Returns a reference to the symbol at the current point."
@@ -193,8 +193,6 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Navigation
 
-(defconst def-use-apology "Sorry, no information on the symbol at point.")
-
 (defvar def-use-marker-ring (make-ring def-use-marker-ring-length)
   "Ring of markers which are locations from which \\[def-use-jump-to-def],
 \\[def-use-jump-to-next], or \\[def-use-jump-to-prev] was invoked.")
@@ -220,8 +218,7 @@
   "Jumps to the definition of the symbol under the cursor."
   (interactive "P")
   (let ((sym (def-use-current-sym)))
-    (if (not sym)
-        (message "%s" def-use-apology)
+    (when sym
       (ring-insert def-use-marker-ring (point-marker))
       (def-use-goto-ref (def-use-sym-ref sym) other-window))))
 
@@ -230,8 +227,7 @@
   (interactive "P")
   (let* ((ref (def-use-current-ref))
          (sym (def-use-sym-at-ref ref)))
-    (if (not sym)
-        (message "%s" def-use-apology)
+    (when sym
       (let* ((refs (def-use-all-refs-sorted sym))
              (refs (if reverse (reverse refs) refs))
              (refs (append refs refs)))
@@ -298,8 +294,7 @@
   (interactive "P")
   (let* ((ref (def-use-current-ref))
          (sym (def-use-sym-at-ref ref)))
-    (if (not sym)
-        (message "%s" def-use-apology)
+    (when sym
       (let* ((name (concat "<:" (def-use-format-sym sym) ":>"))
              (buffer (get-buffer name)))
         (if buffer
@@ -374,8 +369,7 @@
   "Shows info on the symbol under the cursor."
   (interactive)
   (let ((sym (def-use-current-sym)))
-    (if (not sym)
-        (message "%s" def-use-apology)
+    (when sym
       (message "%s" (def-use-format-sym sym)))))
 
 (defun def-use-format-sym (sym)
@@ -472,7 +466,7 @@
   "Highlights the symbol at the point."
   (save-excursion
     (save-window-excursion
-      (def-use-highlight-sym (def-use-current-sym)))))
+      (def-use-highlight-sym (def-use-current-sym t)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Highlighting timer

Modified: mlton/trunk/ide/emacs/esml-du-mlton.el
===================================================================
--- mlton/trunk/ide/emacs/esml-du-mlton.el	2007-07-11 10:15:45 UTC (rev 5756)
+++ mlton/trunk/ide/emacs/esml-du-mlton.el	2007-07-11 11:13:58 UTC (rev 5757)
@@ -98,6 +98,7 @@
                 (function esml-du-sym-at-ref)
                 (function esml-du-sym-to-uses)
                 (function esml-du-finalize)
+                (function esml-du-ctx-attr)
                 ctx))))))
      duf dont-save))))
 




More information about the MLton-commit mailing list