[MLton-commit] r5157

Vesa Karvonen vesak at mlton.org
Fri Feb 9 02:44:47 PST 2007


Apply highlight to all open buffers.
----------------------------------------------------------------------

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

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

Modified: mlton/trunk/ide/emacs/def-use-mode.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-mode.el	2007-02-08 22:24:23 UTC (rev 5156)
+++ mlton/trunk/ide/emacs/def-use-mode.el	2007-02-09 10:44:23 UTC (rev 5157)
@@ -291,15 +291,15 @@
              def-use-list-sym)
     (save-window-excursion
       (let ((b (current-buffer))
-            (sym def-use-list-sym))
+            (length (length (def-use-sym-name def-use-list-sym))))
         (mapc (function
                (lambda (ref-overlay)
                  (unless (cdr ref-overlay)
                    (def-use-goto-ref (car ref-overlay) t)
                    (setcdr ref-overlay
                            (def-use-create-overlay
-                             sym
-                             (car ref-overlay)
+                             length
+                             (def-use-ref-pos (car ref-overlay))
                              (- def-use-priority 1)
                              'def-use-mark-face)))))
               def-use-list-ref-to-overlay-alist)))))
@@ -357,24 +357,20 @@
 ;; Highlighting
 
 (defvar def-use-highlighted-sym nil)
-(defvar def-use-highlighted-buffer nil)
 (defvar def-use-highlighted-overlays nil)
 
 (defun def-use-delete-highlighting ()
   (mapc (function delete-overlay) def-use-highlighted-overlays)
   (setq def-use-highlighted-overlays nil)
-  (setq def-use-highlighted-buffer nil)
   (setq def-use-highlighted-sym nil))
 
 (defun def-use-highlight-ref (sym ref face-attr)
-  ;; XXX Apply highlight to all open buffers
-  (when (equal (def-use-ref-src ref) buffer-file-truename)
-    (push (def-use-create-overlay sym ref def-use-priority face-attr)
-          def-use-highlighted-overlays)))
+  (push (def-use-create-overlay sym ref def-use-priority face-attr)
+        def-use-highlighted-overlays))
 
-(defun def-use-create-overlay (sym ref priority face-attr)
-  (let* ((begin (def-use-pos-to-point (def-use-ref-pos ref)))
-         (beyond (+ begin (length (def-use-sym-name sym))))
+(defun def-use-create-overlay (length pos priority face-attr)
+  (let* ((begin (def-use-pos-to-point pos))
+         (beyond (+ begin length))
          (overlay (make-overlay begin beyond)))
     (overlay-put overlay 'priority priority)
     (overlay-put overlay 'face face-attr)
@@ -382,17 +378,32 @@
 
 (defun def-use-highlight-sym (sym)
   "Highlights the specified symbol."
-  (unless (and (equal def-use-highlighted-sym sym)
-               (equal def-use-highlighted-buffer (current-buffer)))
+  (unless (equal def-use-highlighted-sym sym)
     (def-use-delete-highlighting)
     (when sym
       (setq def-use-highlighted-sym sym)
-      (setq def-use-highlighted-buffer (current-buffer))
-      (def-use-highlight-ref sym (def-use-sym-ref sym) 'def-use-def-face)
-      (mapc (function
-             (lambda (ref)
-               (def-use-highlight-ref sym ref 'def-use-use-face)))
-            (def-use-sym-to-uses sym)))))
+      (let ((length (length (def-use-sym-name sym)))
+            (file-to-poss (def-use-make-hash-table)))
+        (mapc (function
+               (lambda (ref)
+                 (puthash (def-use-ref-src ref)
+                          (cons (def-use-ref-pos ref)
+                                (gethash (def-use-ref-src ref) file-to-poss))
+                          file-to-poss)))
+              (def-use-sym-to-uses sym))
+        (mapc (function
+               (lambda (buffer)
+                 (set-buffer buffer)
+                 (mapc (function
+                        (lambda (pos)
+                          (def-use-highlight-ref length pos 'def-use-use-face)))
+                       (gethash buffer-file-truename file-to-poss))))
+              (buffer-list))
+        (let* ((ref (def-use-sym-ref sym))
+               (buffer (def-use-find-buffer-visiting-file (def-use-ref-src ref))))
+          (when buffer
+            (set-buffer buffer)
+            (def-use-highlight-ref length (def-use-ref-pos ref) 'def-use-def-face)))))))
 
 (defun def-use-highlight-current ()
   "Highlights the symbol at the point."




More information about the MLton-commit mailing list