[MLton-commit] r6285
Vesa Karvonen
vesak at mlton.org
Wed Dec 19 05:49:59 PST 2007
Slightly better error reporting for missing symbol info. In particular,
if there is no symbol at the point or the symbol at the point seems to
differ from the symbol in the info.
Moved basic symbol lookup stuff into a separate file. This is so that a
clear layering (mode -> data -> sym -> util) remains among the def-use
sources.
----------------------------------------------------------------------
U mlton/trunk/ide/emacs/def-use-data.el
U mlton/trunk/ide/emacs/def-use-mode.el
A mlton/trunk/ide/emacs/def-use-sym.el
----------------------------------------------------------------------
Modified: mlton/trunk/ide/emacs/def-use-data.el
===================================================================
--- mlton/trunk/ide/emacs/def-use-data.el 2007-12-19 07:00:10 UTC (rev 6284)
+++ mlton/trunk/ide/emacs/def-use-data.el 2007-12-19 13:49:59 UTC (rev 6285)
@@ -3,7 +3,7 @@
;; MLton is released under a BSD-style license.
;; See the file MLton-LICENSE for details.
-(require 'def-use-util)
+(require 'def-use-sym)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Data records
@@ -148,29 +148,41 @@
result))
(defun def-use-sym-at-ref (ref &optional no-apology)
- (let ((result
- (when ref
+ (when ref
+ (let ((sym
(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))
+ (def-use-dus-sym-at-ref dus ref)))))
+ (name (def-use-extract-sym-name-at-ref ref)))
+ (if (and sym name (string= (def-use-sym-name sym) name))
+ sym
+ (unless no-apology
+ (cond
+ ((not name)
+ (message "Point does not appear to be on a symbol."))
+ ((and sym (not (string= (def-use-sym-name sym) name)))
+ (message "Symbol at point, %s, does not match symbol, %s, in info. Check major mode."
+ name
+ (def-use-sym-name sym)))
+ (t
+ (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 valid info on the symbol: %s. Possible reason: %s."
+ name
+ (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")))))))
+ nil))))
(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-12-19 07:00:10 UTC (rev 6284)
+++ mlton/trunk/ide/emacs/def-use-mode.el 2007-12-19 13:49:59 UTC (rev 6285)
@@ -115,80 +115,13 @@
:group 'def-use)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Points and Positions
-
-(defun def-use-pos-to-point (pos)
- "Returns the value of point in the current buffer at the position."
- (save-excursion
- (goto-line (def-use-pos-line pos))
- (+ (point) (def-use-pos-col pos))))
-
-(defun def-use-point-to-pos (point)
- "Returns the position corresponding to the specified point in the
-current buffer."
- (save-excursion
- (goto-char point)
- (beginning-of-line)
- (let ((line (+ (count-lines 1 (point)) 1))
- (col (- point (point))))
- (def-use-pos line col))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; High-level symbol lookup
-(defvar def-use-mode-to-move-to-symbol-start-alist nil
- "Association list mapping modes to functions that move the point
-backwards to the start of the symbol at the point.")
-
-(defvar def-use-mode-to-move-to-symbol-end-alist nil
- "Association list mapping modes to functions that move the point to the
-end of the symbol at the point.")
-
-(defun def-use-move-to-symbol-start ()
- (let ((mode-move
- (assoc major-mode def-use-mode-to-move-to-symbol-start-alist)))
- (if mode-move
- (funcall (cdr mode-move))
- (skip-syntax-backward "w_" (def-use-point-at-current-line)))))
-
-(defun def-use-move-to-symbol-end ()
- (let ((mode-move
- (assoc major-mode def-use-mode-to-move-to-symbol-end-alist)))
- (if mode-move
- (funcall (cdr mode-move))
- (skip-syntax-forward "w_" (def-use-point-at-next-line)))))
-
-(defun def-use-ref-at-point (point)
- "Returns a reference for the symbol at the specified point in the
-current buffer."
- (let ((src (def-use-buffer-file-truename)))
- (when src
- (def-use-ref src
- (def-use-point-to-pos
- (save-excursion
- (goto-char point)
- (def-use-move-to-symbol-start)
- (point)))))))
-
-(defun def-use-extract-sym-name-at-point (point)
- "Extracts what looks like the name of the symbol at point. This doesn't
-really understand the syntax of the language, so the result is only valid
-when there really is a symbol at the point."
- (save-excursion
- (goto-char point)
- (let* ((start (progn (def-use-move-to-symbol-start) (point)))
- (end (progn (def-use-move-to-symbol-end) (point))))
- (buffer-substring start end))))
-
(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 no-apology)))
- (when (and sym
- (string= (def-use-sym-name sym)
- (def-use-extract-sym-name-at-point point)))
- sym)))))
+ (def-use-sym-at-ref ref no-apology))))
(defun def-use-current-sym (&optional no-apology)
"Returns symbol information for the symbol at the current point."
Copied: mlton/trunk/ide/emacs/def-use-sym.el (from rev 6282, mlton/trunk/ide/emacs/def-use-mode.el)
===================================================================
--- mlton/trunk/ide/emacs/def-use-mode.el 2007-12-18 13:11:04 UTC (rev 6282)
+++ mlton/trunk/ide/emacs/def-use-sym.el 2007-12-19 13:49:59 UTC (rev 6285)
@@ -0,0 +1,86 @@
+;; Copyright (C) 2007 Vesa Karvonen
+;;
+;; MLton is released under a BSD-style license.
+;; See the file MLton-LICENSE for details.
+
+(require 'def-use-util)
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Points and Positions
+
+(defun def-use-pos-to-point (pos)
+ "Returns the value of point in the current buffer at the position."
+ (save-excursion
+ (goto-line (def-use-pos-line pos))
+ (+ (point) (def-use-pos-col pos))))
+
+(defun def-use-point-to-pos (point)
+ "Returns the position corresponding to the specified point in the
+current buffer."
+ (save-excursion
+ (goto-char point)
+ (beginning-of-line)
+ (let ((line (+ (count-lines 1 (point)) 1))
+ (col (- point (point))))
+ (def-use-pos line col))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Basic symbol lookup support
+
+(defvar def-use-mode-to-move-to-symbol-start-alist nil
+ "Association list mapping modes to functions that move the point
+backwards to the start of the symbol at the point.")
+
+(defvar def-use-mode-to-move-to-symbol-end-alist nil
+ "Association list mapping modes to functions that move the point to the
+end of the symbol at the point.")
+
+(defun def-use-move-to-symbol-start ()
+ (let ((mode-move
+ (assoc major-mode def-use-mode-to-move-to-symbol-start-alist)))
+ (if mode-move
+ (funcall (cdr mode-move))
+ (skip-syntax-backward "w_" (def-use-point-at-current-line)))))
+
+(defun def-use-move-to-symbol-end ()
+ (let ((mode-move
+ (assoc major-mode def-use-mode-to-move-to-symbol-end-alist)))
+ (if mode-move
+ (funcall (cdr mode-move))
+ (skip-syntax-forward "w_" (def-use-point-at-next-line)))))
+
+(defun def-use-ref-at-point (point)
+ "Returns a reference for the symbol at the specified point in the
+current buffer."
+ (let ((src (def-use-buffer-file-truename)))
+ (when src
+ (def-use-ref src
+ (def-use-point-to-pos
+ (save-excursion
+ (goto-char point)
+ (def-use-move-to-symbol-start)
+ (point)))))))
+
+(defun def-use-extract-sym-name-at-point (point)
+ "Tries to extracts what looks like the name of the symbol at point.
+This doesn't really understand the syntax of the language, so the result
+is only valid when there really is a symbol at the point."
+ (save-excursion
+ (goto-char point)
+ (let* ((start (progn (def-use-move-to-symbol-start) (point)))
+ (end (progn (def-use-move-to-symbol-end) (point))))
+ (when (and (<= start point)
+ (<= point end)
+ (< start end))
+ (buffer-substring start end)))))
+
+(defun def-use-extract-sym-name-at-ref (ref)
+ "Tries to extract what looks like the name of the symbol at ref."
+ (save-window-excursion
+ (def-use-find-file (def-use-ref-src ref))
+ (def-use-extract-sym-name-at-point
+ (def-use-pos-to-point (def-use-ref-pos ref)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(provide 'def-use-sym)
More information about the MLton-commit
mailing list