camlspotter avatar camlspotter committed 91f1412

count-lines fix

Comments (0)

Files changed (1)

ocamlspot/ocamlspot.el

 ; (***********************************************************************)
 
 ; How-to-use
-; 
+;
 ; Write the following to your .emacs
 ;
-; ; load-path
+;; load-path
 ; (setq load-path (cons "WHERE-YOU-HAVE-INSTALLED-THE-ELISP" load-path))
 ;
-; ; set the path of the ocamlspot binary
-; (setq ocamlspot-path "WHERE-YOU-HAVE-INSTALLED-THE-BINARIES/ocamlspot")
+;; set the path of the ocamlspot binary
+;; this can be a shell command, e.g., "ocamlfind ocamlspot"
+; (setq ocamlspot-command "WHERE-YOU-HAVE-INSTALLED-THE-BINARIES/ocamlspot")
 ;
-; ; autoload
+;; autoload
 ; (autoload 'ocamlspot-query "ocamlspot" "OCamlSpot")
 ;
-; ; tuareg mode hook (use caml-mode-hook instead if you use caml-mode)
-;   (add-hook 'tuareg-mode-hook 
-;   	  '(lambda ()
-; 	     (local-set-key "\C-c;" 'ocamlspot-query)
+;; tuareg mode hook (use caml-mode-hook instead if you use caml-mode)
+;   (add-hook 'tuareg-mode-hook
+;         '(lambda ()
+;            (local-set-key "\C-c;" 'ocamlspot-query)
 ; 	     (local-set-key "\C-c:" 'ocamlspot-query-interface)
-; 	     (local-set-key "\C-c\C-t" 'ocamlspot-type)
+;            (local-set-key "\C-c\C-t" 'ocamlspot-type)
 ;            (local-set-key "\C-c\C-y" 'ocamlspot-type-and-copy)
-; 	     (local-set-key "\C-c\C-u" 'ocamlspot-use)
-; 	     (local-set-key "\C-ct" 'caml-types-show-type)))
-
-; ocamlspot-query 
+;            (local-set-key "\C-c\C-u" 'ocamlspot-use)
+;            (local-set-key "\C-ct" 'caml-types-show-type)))
+;
+;; You can also change overlay colors as follows:
+; (set-face-background 'ocamlspot-spot-face "#660000")
+; (set-face-background 'ocamlspot-tree-face "#006600")
+;
+; ocamlspot-query
 ;   Show the type of the inner-most subexpression under the cursor.
 ;   If there is an identifier under the cursor, browse and show its definition
 ;
 ;
 ; ocamlspot-use
 ;   Show the use information of the identifier under the cursor.
- 
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Configurable variables
 
-(defvar ocamlspot-path "OCAML-SOURCE-TREE/ocamlspot/ocamlspot"
-  "ocamlspot program path")
+(eval-when-compile (require 'cl)) ; for `destructuring-bind'
 
-(defvar ocamlspot-debug nil 
-  "turn on debug output")
+(defgroup ocamlspot ()
+  "OCamlSpotter: find the definition and type of variables."
+  :group 'languages)
 
-(defvar ocamlspot-support-older-version t
-  "if t, support an older command line interface for the first versions of ocamlspot, with an overhead of version detection") 
+(defcustom ocamlspot-command "OCAML-SOURCE-TREE/ocamlspot/ocamlspot"
+  "*The command which invokes ocamlspot."
+  :type 'string :group 'ocamlspot)
 
-; You can also change overlay colors as follows:
-; (set-face-background 'ocamlspot-spot-face "#660000")
-; (set-face-background 'ocamlspot-tree-face "#006600")
+(defcustom ocamlspot-debug nil
+  "*Turn on ocamlspot debug output."
+  :type 'boolean :group 'ocamlspot)
+
+(defcustom ocamlspot-support-older-version nil
+  "*If t, support an older command line interface for the first versions of ocamlspot, with an overhead of version detection. Useful with multiple versions of ocamlspot."
+  :type 'boolean :group 'ocamlspot)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Constants
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Debugging
 
 (defun ocamlspot-debug-message (s)
-  (save-excursion
-    (if (get-buffer ocamlspot-debug-buffer) ()
-      (generate-new-buffer ocamlspot-debug-buffer))
-    (set-buffer ocamlspot-debug-buffer)
+  (with-current-buffer (get-buffer-create ocamlspot-debug-buffer)
     (insert s)
     (insert "\n")))
 
 
 ; This looks complicated, but we need this conversion for multi-byte characters
 
-(defun ocamlspot-pos-beginning-of-line ()
-  (save-excursion
-    (beginning-of-line)
-    (point)))
- 
 (defun ocamlspot-string-of-line-to-point ()
-  (buffer-substring-no-properties 
-   (ocamlspot-pos-beginning-of-line) (point)))
+  (buffer-substring-no-properties
+   (line-beginning-position) (point)))
 
 (defun ocamlspot-bytes-of-line-to-point ()
-  (length 
-   (encode-coding-string 
+  (length
+   (encode-coding-string
     (ocamlspot-string-of-line-to-point) buffer-file-coding-system)))
 
+; It count one line less when the cursor is at (point-max) 
+; and it is at the top of the line.
 (defun ocamlspot-lines-of-point ()
-  (count-lines (point-min) (point)))
+  (count-lines (point-min) (min (1+ (point)) (point-max))))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; column bytes => column chars  
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; column bytes => column chars
 
 ; This looks complicated, but we need this conversion for multi-byte characters
 
 ; goto-line set mark and we see the result in the minibuffer
 (defun ocamlspot-goto-line (line)
   (goto-char (point-min))
-  (forward-line (- line 1)))
+  (forward-line (1- line)))
 
 ;; get the string at line
 (defun ocamlspot-buffer-substring-at-line (line)
   ; no need of save-excursion
   (ocamlspot-goto-line line)
-  (beginning-of-line)
-  (let ((start (point)))
-    (end-of-line)
-    (buffer-substring-no-properties start (point))))
+  (buffer-substring-no-properties (line-beginning-position)
+                                  (line-end-position)))
 
 (defun ocamlspot-chars-of-bytes-of-string (str bytes)
-  (length 
-   (decode-coding-string 
+  (length
+   (decode-coding-string
     (substring (encode-coding-string str buffer-file-coding-system)
                0 bytes)
     buffer-file-coding-system)))
 (defun ocamlspot-pos-of-bytes-at-line (line bytes)
   ; no need of save-excursion
   (ocamlspot-goto-line line)
-  (let ((pos-at-beginning-of-line (ocamlspot-pos-beginning-of-line))
-        (chars-from-beginning-of-line 
-         (ocamlspot-chars-of-bytes-of-string 
+  (let ((pos-at-beginning-of-line (line-beginning-position))
+        (chars-from-beginning-of-line
+         (ocamlspot-chars-of-bytes-of-string
           (ocamlspot-buffer-substring-at-line line) bytes)))
     (+ pos-at-beginning-of-line chars-from-beginning-of-line)))
 
 ; parses lxxxcxxxbxxx and returns the triplet
 (defun ocamlspot-parse-location (s)
   (if (string-match "^l\\([\-0-9]+\\)c\\([\-0-9]+\\)b\\([\-0-9]+\\)$" s)
-      (let ((line (string-to-int 
+      (let ((line (string-to-number
                    (substring s (match-beginning 1) (match-end 1))))
-            (colbytes (string-to-int
+            (colbytes (string-to-number
                        (substring s (match-beginning 2) (match-end 2))))
-            (bytes (string-to-int
+            (bytes (string-to-number
                        (substring s (match-beginning 3) (match-end 3)))))
         (list line colbytes bytes))
     ; older version
     (if (string-match "^\\([\-0-9]+\\)$" s)
         (let ((line -1)
               (colbytes -1)
-              (bytes (string-to-int
+              (bytes (string-to-number
                       (substring s (match-beginning 1) (match-end 1)))))
           (list line colbytes (+ bytes 1)))
       nil)))
 (defun ocamlspot-pos-of-location (buffer s)
   (destructuring-bind (line colbytes bytes) (ocamlspot-parse-location s)
     (if (= line -1) bytes
-      (save-excursion
-        (set-buffer buffer)
+      (with-current-buffer buffer
         (ocamlspot-pos-of-bytes-at-line line colbytes)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Overlays
 
-(defvar ocamlspot-spot-face-color "#88FF44" "color for the spot face") 
-(defvar ocamlspot-spot-tree-color "#FF88FF" "color for the spot tree")
-
 ;; the spot overlay
 (defvar ocamlspot-spot-overlay (make-overlay 1 1))
-(make-face 'ocamlspot-spot-face)
-(set-face-doc-string 'ocamlspot-spot-face "face for ocamlspot spot highlight")
-(set-face-background 'ocamlspot-spot-face ocamlspot-spot-face-color)
+(defface ocamlspot-spot-face
+    '((t (:foreground "#88FF44")))
+  "Face for ocamlspot spot highlight"
+  :group 'ocamlspot)
 (overlay-put ocamlspot-spot-overlay 'face 'ocamlspot-spot-face)
 
 ;; the tree overlay
 (defvar ocamlspot-tree-overlay (make-overlay 1 1))
-(make-face 'ocamlspot-tree-face)
-(set-face-doc-string 'ocamlspot-tree-face "face for ocamlspot tree highlight")
-(set-face-background 'ocamlspot-tree-face ocamlspot-spot-tree-color)
+(defface ocamlspot-tree-face
+    '((t (:foreground "#FF88FF")))
+  "Face for ocamlspot tree highlight"
+  :group 'ocamlspot)
 (overlay-put ocamlspot-tree-overlay 'face 'ocamlspot-tree-face)
 
 (defun ocamlspot-delete-overlays-now ()
 ; (defun ocamlspot-display-overlay (filename position overlay)
 ;   (if (string-match "\.cm[ioxa]$" filename)
 ;       ;; It is not an .ml or .mli. Packed module.
-;       (progn 
+;       (progn
 ;         (message "Packed module: %s" filename)
 ;         ;; CR jfuruse: opening a binary file is not good
 ;         (setq target-buffer (ocamlspot-find-file-existing filename)))
 ;                 (move-overlay overlay start end target-buffer))))))))
 
 (defun ocamlspot-display-overlay (buffer position overlay)
-  (if (string-match "^\\(l[\-0-9]+c[\-0-9]+b[\-0-9]+\\|[\-0-9]+\\):\\(l[\-0-9]+c[\-0-9]+b[\-0-9]+\\|[\-0-9]+\\)$" position)
+  (if (string-match "^\\(l[\-0-9]+c[\-0-9]+b[\-0-9]+\\|[0-9]+\\):\\(l[\-0-9]+c[\-0-9]+b[\-0-9]+\\|[0-9]+\\)$" position)
       (let ((start (substring position (match-beginning 1) (match-end 1)))
             (end   (substring position (match-beginning 2) (match-end 2))))
         (let ((start (ocamlspot-pos-of-location buffer start))
           (goto-char start)
           (move-overlay overlay start end buffer)))
     ; this should be all
-    (progn
-      (display-buffer buffer)
-      (move-overlay overlay (point-min) (point-max) buffer))))
+    (display-buffer buffer)
+    (move-overlay overlay (point-min) (point-max) buffer)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Warnings
 
 (defun ocamlspot-warning ()
-  (if (re-search-forward "^\\(Warning: .*\\)$" nil t)
-      (buffer-substring-no-properties (match-beginning 1) (match-end 1))
-    nil))
+  (and (re-search-forward "^\\(Warning: .*\\)$" nil t)
+       (buffer-substring-no-properties (match-beginning 1) (match-end 1))))
 
 (defun ocamlspot-warnings-rev (lst)
   (let ((warning (ocamlspot-warning)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Queries
 
-; It is all my failure, but the first versions of ocamlspot lacks clear notion 
+; It is all my failure, but the first versions of ocamlspot lacks clear notion
 ; of versions. This function infers the command option interface of the command
 ; from the help string. If t, ocamlspot cannot take line-bytes specifications.
 (defun ocamlspot-older-version ()
   (if ocamlspot-support-older-version
-      (save-current-buffer
-        (set-buffer (get-buffer-create ocamlspot-buffer))
+      (with-current-buffer (get-buffer-create ocamlspot-buffer)
         (erase-buffer)
-        (call-process ocamlspot-path nil ocamlspot-buffer nil "-help")
+        (call-process shell-file-name nil t nil shell-command-switch
+                      (concat ocamlspot-command " -help"))
         (goto-char (point-min))
         (re-search-forward "^ocamlspot path:charpos" nil t))
     nil))
 
-; launch ocamlspot 
+; launch ocamlspot
 ; result is stored in the buffer "ocamlspot-buffer"
 ; the current buffer is stored in source_buffer
 (defun ocamlspot-gen-query (extra_args)
                    ; older pos spec
                    (format "%s:%d"
                            (buffer-file-name)
-                           (- (point) 1))
+                           (1- (point)))
                    ; newer pos spec
                    (format "%s:l%dc%d"
                            (buffer-file-name)
                            (ocamlspot-lines-of-point)
-                           (ocamlspot-bytes-of-line-to-point)))
-           ))
-      ;; ocamlspot buffer
-      (setq source-buffer (current-buffer))
-      (save-current-buffer
-        (set-buffer (get-buffer-create ocamlspot-buffer))
+                           (ocamlspot-bytes-of-line-to-point))))
+          (source-buffer (current-buffer))) ; ocamlspot buffer
+      (with-current-buffer (get-buffer-create ocamlspot-buffer)
         (erase-buffer)
-        (let* ((debug
-  	      ; (if ocamlspot-debug '("--debug") nil))
-                (if ocamlspot-debug '("-debug") nil))
-  	     (command 
-  	      (append '(call-process ocamlspot-path nil ocamlspot-buffer nil)
-                        ; '("--version") ; it's new
-  		      debug
-  		      extra_args
-  		      '(arg))))
-          ;; chdir is required
-          (cd (file-name-directory file-name))
-  	(eval command))
+        ;; chdir is required
+        (cd (file-name-directory file-name))
+        (call-process shell-file-name nil t nil shell-command-switch
+                      (concat ocamlspot-command " " arg
+                              (if ocamlspot-debug " -debug " " ")
+                              extra_args))
         ;; search the found tree element
         (goto-char (point-min))
-        (if (re-search-forward "^Tree: \\(l[\-0-9]+c[\-0-9]+b[\-0-9]+:l[\-0-9]+c[\-0-9]+b[\-0-9]+\\|[0-9]+:[0-9]+\\)$" 
-  			     nil t)
+        (if (re-search-forward "^Tree: \\(l[\-0-9]+c[\-0-9]+b[\-0-9]+:l[\-0-9]+c[\-0-9]+b[\-0-9]+\\|[0-9]+:[0-9]+\\)$"
+                             nil t)
             (let ((pos (buffer-substring (match-beginning 1) (match-end 1))))
               ;; display the result
               (save-current-buffer
                 (ocamlspot-display-overlay source-buffer pos ocamlspot-tree-overlay))
               (message (ocamlspot-warnings))
               t)
-          (progn 
-            (if (re-search-forward "^\\(Error: .*\\)" nil t)
-                (message (buffer-substring (match-beginning 1) (match-end 1)))
+          (if (re-search-forward "^\\(Error: .*\\)" nil t)
+              (message (buffer-substring (match-beginning 1) (match-end 1)))
               ;; display debug info
               (message "ERROR: no tree node found there"))
-            nil))))))
+            nil)))))
 
 (defun ocamlspot-jump-to-spot (filename position)
   (if (string-match "\.cm[ioxa]$" filename)
       ;; It is not an .ml or .mli. Packed module.
-      (progn 
-        (message "Packed module: %s" filename)
-        ;; CR jfuruse: opening a binary file is not good
-        )
-    (ocamlspot-display-overlay 
+      ;; CR jfuruse: opening a binary file is not good
+      (message "Packed module: %s" filename)
+    (ocamlspot-display-overlay
      (ocamlspot-find-file-existing filename)
      position ocamlspot-spot-overlay)))
 
   (goto-char (point-min))
   (if (re-search-forward "^Type: \\(.*\\(\n +.*\\)*\\)" nil t)
       (let ((type (buffer-substring (match-beginning 1) (match-end 1))))
-	(if to-kill (kill-new type))
-	(message "Type: %s" type)
-	type)
-    (progn 
-      (message "no type found here")
-      nil)))
+        (if to-kill (kill-new type))
+        (message "Type: %s" type)
+        type)
+    (message "no type found here")
+    nil))
 
 (defun ocamlspot-find-val-or-type-in-buffer (&optional to-kill)
   (set-buffer (get-buffer-create ocamlspot-buffer))
   (goto-char (point-min))
   (if (re-search-forward "^Val: \\(.*\\(\n +.*\\)*\\)" nil t)
       (let ((type (buffer-substring (match-beginning 1) (match-end 1))))
-	(if to-kill (kill-new type))
-	(message "Val: %s" type)
-	type)
+        (if to-kill (kill-new type))
+        (message "Val: %s" type)
+        type)
     (ocamlspot-find-type-in-buffer to-kill)))
 
 (defun ocamlspot-find-spot-in-buffer ()
   (set-buffer (get-buffer-create ocamlspot-buffer))
   (goto-char (point-min))
-  (if (re-search-forward "^Spot: \\(.*\\):\\(l[\-0-9]+c[\-0-9]+b[\-0-9]+:l[\-0-9]+c[\-0-9]+b[\-0-9]+\\|[0-9]+:[0-9]+\\|all\\)$" 
-			 nil t)
-      (let ((filename (buffer-substring (match-beginning 1) 
-					(match-end 1)))
-	    (position (buffer-substring (match-beginning 2)
-					(match-end 2))))
-	;; display the result
-	(let ((type (ocamlspot-find-val-or-type-in-buffer)))
-	  (ocamlspot-jump-to-spot filename position)
-	  (if type (message "Type: %s" type))))
-    (progn
-      (if (re-search-forward "^Spot: \\(.*\\)" nil t)
-	  (message (buffer-substring (match-beginning 1) (match-end 1)))
-	(if (re-search-forward "^\\(Error: .*\\)" nil t)
-	    (message (buffer-substring (match-beginning 1) (match-end 1)))
-	  (progn
-	    ;; display debug info
-	    (message "No spot found there") 
-	    (ocamlspot-find-val-or-type-in-buffer)
-	    ;; (display-buffer ocamlspot-buffer)
-	    ))))))
+  ;; all and -1:-1 mean the whole file
+  (if (re-search-forward "^Spot: \\(.*\\):\\(l[\-0-9]+c[\-0-9]+b[\-0-9]+:l[\-0-9]+c[\-0-9]+b[\-0-9]+\\|[0-9]+:[0-9]+\\|all\\|-1:-1\\)$"
+                         nil t)
+      (let ((filename (buffer-substring (match-beginning 1)
+                                        (match-end 1)))
+            (position (buffer-substring (match-beginning 2)
+                                        (match-end 2))))
+        ;; display the result
+        (let ((type (ocamlspot-find-val-or-type-in-buffer)))
+          (ocamlspot-jump-to-spot filename position)
+          (if type (message "Type: %s" type))))
+    (if (re-search-forward "^Spot: \\(.*\\)" nil t)
+        (message (buffer-substring (match-beginning 1) (match-end 1)))
+      (if (re-search-forward "^\\(Error: .*\\)" nil t)
+          (message (buffer-substring (match-beginning 1) (match-end 1)))
+        ;; display debug info
+        (message "No spot found there")
+        (ocamlspot-find-val-or-type-in-buffer)
+        ))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Interactives
 
   (interactive)
   (let ((sel-window (selected-window)))
   (save-selected-window
-    (if (ocamlspot-gen-query nil)
-        (progn ;save-excursion
-          ;; search the result
-          (ocamlspot-find-spot-in-buffer)))
+    (when (ocamlspot-gen-query nil)
+      ;; search the result
+      (ocamlspot-find-spot-in-buffer))
     (ocamlspot-delete-overlays)) ; CR jfuruse: it depends on one's taste
   ; I dunno why but we need the following line to list-buffers work nicely
   (select-window sel-window)))
   (interactive)
   (let ((sel-window (selected-window)))
   (save-selected-window
-    (if (ocamlspot-gen-query '("--interface"))
+    (if (ocamlspot-gen-query "--interface")
         (progn ;save-excursion
           ;; search the result
           (ocamlspot-find-spot-in-buffer)))
 
 (defun ocamlspot-type (&optional to-kill)
   (interactive)
-  (if (ocamlspot-gen-query '("-n"))
-      (save-current-buffer 
-	(ocamlspot-find-val-or-type-in-buffer to-kill)))
+  (if (ocamlspot-gen-query "-n")
+      (save-current-buffer
+        (ocamlspot-find-val-or-type-in-buffer to-kill)))
   (ocamlspot-delete-overlays))
 
 (defun ocamlspot-type-and-copy ()
 ; CR can be shared with ocamlspot-type
 (defun ocamlspot-use ()
   (interactive)
-  (if (ocamlspot-gen-query '("-n"))
-      (save-current-buffer 
-	(set-buffer (get-buffer-create ocamlspot-buffer))
-	(goto-char (point-min))
-	(if (re-search-forward "^Use: \\(.*\\(\n +.*\\)*\\)" nil t)
-	    (let ((type (buffer-substring (match-beginning 1) (match-end 1))))
-	      (message type))
-	  (message "no use information found here"))))
+  (if (ocamlspot-gen-query "-n")
+      (save-current-buffer
+        (set-buffer (get-buffer-create ocamlspot-buffer))
+        (goto-char (point-min))
+        (if (re-search-forward "^Use: \\(.*\\(\n +.*\\)*\\)" nil t)
+            (let ((type (buffer-substring (match-beginning 1) (match-end 1))))
+              (message type))
+          (message "no use information found here"))))
   (ocamlspot-delete-overlays))
 
+(defun ocamlspot-display-ocamlspot-buffer ()
+  (interactive)
+  (display-buffer ocamlspot-buffer))
+
 (provide 'ocamlspot)
Tip: Filter by directory path e.g. /media app.js to search for public/media/app.js.
Tip: Use camelCasing e.g. ProjME to search for ProjectModifiedEvent.java.
Tip: Filter by extension type e.g. /repo .js to search for all .js files in the /repo directory.
Tip: Separate your search with spaces e.g. /ssh pom.xml to search for src/ssh/pom.xml.
Tip: Use ↑ and ↓ arrow keys to navigate and return to view the file.
Tip: You can also navigate files with Ctrl+j (next) and Ctrl+k (previous) and view the file with Ctrl+o.
Tip: You can also navigate files with Alt+j (next) and Alt+k (previous) and view the file with Alt+o.