[MLton-commit] r5145

Vesa Karvonen vesak at mlton.org
Tue Feb 6 07:20:25 PST 2007


Avoid reopening files that are already open.
Sanitized window / buffer handling in mark list mode.

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

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

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

Modified: mlton/trunk/ide/emacs/def-use-mode.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-mode.el	2007-02-06 02:50:10 UTC (rev 5144)
+++ mlton/trunk/ide/emacs/def-use-mode.el	2007-02-06 15:20:13 UTC (rev 5145)
@@ -172,9 +172,9 @@
 position."
   (cond
    (other-window
-    (find-file-other-window (def-use-ref-src ref)))
+    (def-use-find-file (def-use-ref-src ref) t))
    ((not (equal (def-use-buffer-true-file-name) (def-use-ref-src ref)))
-    (find-file (def-use-ref-src ref))))
+    (def-use-find-file (def-use-ref-src ref))))
   (def-use-goto-pos (def-use-ref-pos ref)))
 
 (defun def-use-goto-pos (pos)
@@ -224,9 +224,9 @@
       (let* ((name (concat "<:" (def-use-format-sym sym) ":>"))
              (buffer (get-buffer name)))
         (if buffer
-            (pop-to-buffer buffer)
+            (switch-to-buffer-other-window buffer)
           (setq buffer (get-buffer-create name))
-          (pop-to-buffer buffer)
+          (switch-to-buffer-other-window buffer)
           (buffer-disable-undo)
           (def-use-list-mode)
           (add-hook
@@ -256,27 +256,27 @@
                (< idx (length def-use-list-ref-to-overlay-alist)))
       (forward-line)
       (def-use-goto-ref (car (nth idx def-use-list-ref-to-overlay-alist)) t)
-      (pop-to-buffer b))))
+      (switch-to-buffer-other-window b))))
 
 (defun def-use-list-view-mark-all ()
   "Visits all the references and marks them."
   (interactive)
   (when (and def-use-list-ref-to-overlay-alist
              def-use-list-sym)
-    (let ((b (current-buffer))
-          (sym 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)
-                           (- def-use-priority 1)
-                           'def-use-mark-face))
-                 (pop-to-buffer b))))
-            def-use-list-ref-to-overlay-alist))))
+    (save-window-excursion
+      (let ((b (current-buffer))
+            (sym 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)
+                             (- def-use-priority 1)
+                             'def-use-mark-face)))))
+              def-use-list-ref-to-overlay-alist)))))
 
 (defun def-use-list-view-unmark-all ()
   "Kills all the marks associated with the list view."

Modified: mlton/trunk/ide/emacs/def-use-util.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-util.el	2007-02-06 02:50:10 UTC (rev 5144)
+++ mlton/trunk/ide/emacs/def-use-util.el	2007-02-06 15:20:13 UTC (rev 5145)
@@ -28,6 +28,23 @@
     (when name
       (def-use-file-truename name))))
 
+(defun def-use-find-file (file &optional other-window)
+  "Roughly as `find-file' or `find-file-other-window' except that will not
+open the file a second time if a buffer is editing a file by the same true
+file name."
+  (let* ((truename (def-use-file-truename file))
+         (buffer (loop for buffer in (buffer-list) do
+                   (if (with-current-buffer buffer
+                         (string= buffer-file-truename truename))
+                       (return buffer)))))
+    (if buffer
+        (if other-window
+            (switch-to-buffer-other-window buffer)
+          (switch-to-buffer buffer))
+      (if other-window
+          (find-file-other-window truename)
+        (find-file truename)))))
+
 (defun def-use-point-at-next-line ()
   "Returns point at the beginning of the next line."
   (save-excursion




More information about the MLton-commit mailing list