[MLton-commit] r5122
Vesa Karvonen
vesak at mlton.org
Sun Feb 4 06:38:06 PST 2007
Added ability to mark (and unmark) all refs to a symbols in list view.
----------------------------------------------------------------------
U mlton/trunk/ide/emacs/def-use-data.el
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-data.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-data.el 2007-02-04 09:14:55 UTC (rev 5121)
+++ mlton/trunk/ide/emacs/def-use-data.el 2007-02-04 14:38:05 UTC (rev 5122)
@@ -112,7 +112,7 @@
(defun def-use-show-dus-del ()
"Kill the def-use source on the current line."
(interactive)
- (let ((idx (- (count-lines 1 (def-use-point-at-current-line)) 2)))
+ (let ((idx (- (def-use-current-line) 3)))
(when (and (<= 0 idx)
(< idx (length def-use-dus-list)))
(def-use-rem-dus (nth idx def-use-dus-list)))))
Modified: mlton/trunk/ide/emacs/def-use-mode.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-mode.el 2007-02-04 09:14:55 UTC (rev 5121)
+++ mlton/trunk/ide/emacs/def-use-mode.el 2007-02-04 14:38:05 UTC (rev 5122)
@@ -24,10 +24,7 @@
;; purging, and reloading of def-use info) in the near future.
;; TBD:
-;; - highlight all refs to a var while def-use-list buffer exists
;; - mode specific on-off switching
-;; - automatic loading of def-use files
-;; - automatic reloading of modified def-use files
;; - disable def-use when file is modified
;; - use mode dependent identifier charset (e.g also skip over _ in sml-mode)
;; - rename-variable
@@ -55,6 +52,13 @@
:group 'faces
:group 'def-use)
+(defface def-use-mark-face
+ '((((class color)) (:background "orchid1"))
+ (t (:background "gray")))
+ "Face for highlighting uses."
+ :group 'faces
+ :group 'def-use)
+
(defcustom def-use-delay 0.125
"Idle time in seconds to delay before updating highlighting."
:type '(number :tag "seconds")
@@ -193,23 +197,32 @@
(defconst def-use-ref-regexp "\\([^ ]+\\):\\([0-9]+\\)\\.\\([0-9]+\\)")
-(defvar def-use-list-mode-map
+(defconst def-use-list-mode-map
(let ((result (make-sparse-keymap)))
(mapc (function
(lambda (key-command)
(define-key result
(read (car key-command))
(cdr key-command))))
- '(("[(q)]"
- . def-use-kill-current-buffer)
+ `(("[(b)]"
+ . ,(function bury-buffer))
+ ("[(m)]"
+ . ,(function def-use-list-view-mark-all))
+ ("[(u)]"
+ . ,(function def-use-list-view-kill-marks))
+ ("[(q)]"
+ . ,(function def-use-kill-current-buffer))
("[(return)]"
- . def-use-list-view-ref)))
+ . ,(function def-use-list-view-ref))))
result))
(define-derived-mode def-use-list-mode fundamental-mode "Def-Use-List"
"Major mode for browsing def-use lists."
:group 'def-use-list)
+(defvar def-use-list-ref-to-overlay-alist nil)
+(defvar def-use-list-sym nil)
+
(defun def-use-list-all-refs (&optional reverse)
"Lists all references to the symbol under the cursor."
(interactive "P")
@@ -217,38 +230,76 @@
(sym (def-use-sym-at-ref ref)))
(if (not sym)
(message "Sorry, no known symbol at cursor.")
- (let* ((buffer (generate-new-buffer
- (concat "<" (def-use-format-sym-title sym) ">"))))
- (set-buffer buffer)
- (buffer-disable-undo)
- (insert (def-use-format-sym sym) "\n"
- "\n")
- (let* ((refs (def-use-all-refs-sorted sym))
- (refs (if reverse (reverse refs) refs)))
- (mapc (function
- (lambda (ref)
- (insert (def-use-format-ref ref) "\n")))
- refs))
- (goto-line 3)
- (pop-to-buffer buffer)
- (setq buffer-read-only t)
- (def-use-list-mode)))))
+ (let* ((name (concat "<:" (def-use-format-sym sym) ":>"))
+ (buffer (get-buffer name)))
+ (if buffer
+ (pop-to-buffer buffer)
+ (setq buffer (get-buffer-create name))
+ (pop-to-buffer buffer)
+ (buffer-disable-undo)
+ (def-use-list-mode)
+ (add-hook
+ 'kill-buffer-hook (function def-use-list-view-kill-marks) nil t)
+ (set (make-local-variable 'def-use-list-sym)
+ sym)
+ (insert (def-use-format-sym sym) "\n"
+ "\n")
+ (let* ((refs (def-use-all-refs-sorted sym))
+ (refs (if reverse (reverse refs) refs)))
+ (set (make-local-variable 'def-use-list-ref-to-overlay-alist)
+ (mapcar (function list) refs))
+ (mapc (function
+ (lambda (ref)
+ (insert (def-use-format-ref ref) "\n")))
+ refs))
+ (goto-line 3)
+ (setq buffer-read-only t))))))
(defun def-use-list-view-ref ()
"Finds references on the current line and shows in another window."
(interactive)
(beginning-of-line)
- (let ((b (current-buffer)))
- (when (re-search-forward def-use-ref-regexp (def-use-point-at-next-line) t)
+ (let ((b (current-buffer))
+ (idx (- (def-use-current-line) 3)))
+ (when (and (<= 0 idx)
+ (< idx (length def-use-list-ref-to-overlay-alist)))
(forward-line)
- (def-use-goto-ref
- (def-use-ref (match-string 1)
- (def-use-pos
- (string-to-number (match-string 2))
- (string-to-number (match-string 3))))
- t)
+ (def-use-goto-ref (car (nth idx def-use-list-ref-to-overlay-alist)) t)
(pop-to-buffer 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))
+ (l (length (def-use-sym-name def-use-list-sym))))
+ (mapc (function
+ (lambda (ref-overlay)
+ (let ((ref (car ref-overlay))
+ (overlay (cdr ref-overlay)))
+ (unless overlay
+ (def-use-goto-ref ref t)
+ (let* ((begin (def-use-pos-to-point (def-use-ref-pos ref)))
+ (beyond (+ begin l))
+ (overlay (make-overlay begin beyond)))
+ (setcdr ref-overlay overlay)
+ (overlay-put overlay 'priority (- def-use-priority 1))
+ (overlay-put overlay 'face 'def-use-mark-face)
+ (pop-to-buffer b))))))
+ def-use-list-ref-to-overlay-alist))))
+
+(defun def-use-list-view-kill-marks ()
+ "Kills all the marks associated with the list view."
+ (interactive)
+ (when def-use-list-ref-to-overlay-alist
+ (mapc (function
+ (lambda (ref-overlay)
+ (when (cdr ref-overlay)
+ (delete-overlay (cdr ref-overlay))
+ (setcdr ref-overlay nil))))
+ def-use-list-ref-to-overlay-alist)))
+
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Info
Modified: mlton/trunk/ide/emacs/def-use-util.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-util.el 2007-02-04 09:14:55 UTC (rev 5121)
+++ mlton/trunk/ide/emacs/def-use-util.el 2007-02-04 14:38:05 UTC (rev 5122)
@@ -38,6 +38,10 @@
(beginning-of-line)
(point)))
+(defun def-use-current-line ()
+ "Returns the current line number counting from 1."
+ (+ 1 (count-lines 1 (def-use-point-at-current-line))))
+
(if (string-match "XEmacs" emacs-version)
(defalias 'def-use-delete-timer (function delete-itimer))
(defalias 'def-use-delete-timer (function cancel-timer)))
More information about the MLton-commit
mailing list