1. camlspotter
  2. mutated_ocaml

Commits

camlspotter  committed dcae701

multibyte support

  • Participants
  • Parent commits 9c39204
  • Branches ocamlspot

Comments (0)

Files changed (1)

File ocamlspot/ocamlspot.el

View file
  • Ignore whitespace
 
 (defvar ocamlspot-buffer "*ocamlspot*")
 
+(defvar ocamlspot-debug-buffer "*ocamlspot-debug*")
+(defun ocamlspot-debug-message (s)
+  (if (get-buffer ocamlspot-debug-buffer)
+      ()
+    (generate-new-buffer ocamlspot-debug-buffer))
+  (save-excursion
+    (set-buffer ocamlspot-debug-buffer)
+    (insert s)
+    (insert "\n")))
+
 (defvar ocamlspot-path "OCAML-SOURCE-TREE/ocamlspot/ocamlspot"
   "ocamlspot program path")
 
 (set-face-background 'ocamlspot-spot-face "#88FF44")
 (overlay-put ocamlspot-spot-overlay 'face 'ocamlspot-spot-face)
 
-(defun ocamlspot-display-spot-overlay (buffer start end)
-  (interactive)
-  ; (if (not (overlayp ocamlspot-spot-overlay)) (ocamlspot-spot-overlay-init))
-  (move-overlay ocamlspot-spot-overlay start end buffer))
-
 ;; the tree overlay
 (defvar ocamlspot-tree-overlay (make-overlay 1 1))
 (make-face 'ocamlspot-tree-face)
 (set-face-background 'ocamlspot-tree-face "#FF88FF")
 (overlay-put ocamlspot-tree-overlay 'face 'ocamlspot-tree-face)
 
+(defun ocamlspot-display-spot-overlay (buffer start end)
+  (interactive)
+  ; (if (not (overlayp ocamlspot-spot-overlay)) (ocamlspot-spot-overlay-init))
+  (move-overlay ocamlspot-spot-overlay start end buffer))
+
 (defun ocamlspot-display-tree-overlay (buffer start end)
   (move-overlay ocamlspot-tree-overlay start end buffer))
 
 
 (defun ocamlspot-lines-of-point ()
   (count-lines (point-min) (point)))
-  
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; column bytes => column chars  
+
+;; get the string at line
+(defun ocamlspot-buffer-substring-at-line (line)
+  (save-excursion
+    (goto-line line)
+    (beginning-of-line)
+    (let ((start (point)))
+      (end-of-line)
+      (buffer-substring-no-properties start (point)))))
+
+(defun ocamlspot-chars-of-bytes-of-string (str bytes)
+  (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)
+  (save-excursion
+    (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 
+            (ocamlspot-buffer-substring-at-line line) bytes)))
+      (+ pos-at-beginning-of-line chars-from-beginning-of-line))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; location parser
 
+; 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 
           (list line colbytes bytes))
       nil)))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+(defun ocamlspot-pos-of-location (buffer s)
+  (destructuring-bind (line colbytes bytes) (ocamlspot-parse-location s)
+    (if (= line -1) bytes
+      (save-current-buffer
+        (set-buffer buffer)
+        (ocamlspot-pos-of-bytes-at-line line colbytes)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; overlay handling
+
+; (defun ocamlspot-display-overlay (filename position overlay)
+;   (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
+;         (setq target-buffer (ocamlspot-find-file-existing filename)))
+;     (progn
+;       (setq target-buffer (ocamlspot-find-file-existing filename))
+;       (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 target-buffer start))
+;                   (end   (ocamlspot-pos-of-location target-buffer end)))
+;               ;; display the result
+;               (save-excursion
+;                 (set-buffer target-buffer)
+;                 (goto-char start)
+;                 (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)
+      (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))
+              (end   (ocamlspot-pos-of-location buffer end)))
+          ;; display the result
+          (set-buffer buffer)
+          (goto-char start)
+          (move-overlay overlay start end buffer)))
+    ; this should be all
+    (progn
+      (set-buffer buffer)
+      (move-overlay overlay (point-min) (point-max) buffer))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
 
 ; launch ocamlspot 
 ; result is stored in the buffer "ocamlspot-buffer"
 	(eval command))
       ;; 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]+\\)$" 
+      (if (re-search-forward "^Tree: \\(l[\-0-9]+c[\-0-9]+b[\-0-9]+:l[\-0-9]+c[\-0-9]+b[\-0-9]+\\)$" 
 			     nil t)
-	  (let ((start 
-		 (ocamlspot-char-of-cnum 
-		  (string-to-int 
-		   (buffer-substring (match-beginning 1) (match-end 1)))))
-		(end 
-		 (ocamlspot-char-of-cnum
-		  (string-to-int
-		   (buffer-substring (match-beginning 2) (match-end 2))))))
-	      
-              ;; display the result
-	      (ocamlspot-display-tree-overlay source-buffer start end)
-	      t)
-          (progn 
-            (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)))))
+          (let ((pos (buffer-substring (match-beginning 1) (match-end 1))))
+            ;; display the result
+            (ocamlspot-display-overlay source-buffer pos ocamlspot-tree-overlay)
+            t)
+        (progn 
+          (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)))))
 
 (defun ocamlspot-jump-to-spot (filename position)
   (if (string-match "\.cm[ioxa]$" filename)
       (progn 
         (message "Packed module: %s" filename)
         ;; CR jfuruse: opening a binary file is not good
-        (setq target-buffer (ocamlspot-find-file-existing filename)))
+        )
     (progn
-      (setq target-buffer (ocamlspot-find-file-existing filename))
-      (if (string-match "^l[\-0-9]+c[\-0-9]+b\\([\-0-9]+\\):l[\-0-9]+c[\-0-9]+b\\([\-0-9]+\\)$" position)
-          (let ((start 
-                 (ocamlspot-char-of-cnum 
-                  (string-to-int 
-                   (substring position (match-beginning 1) (match-end 1)))))
-                (end 
-                 (ocamlspot-char-of-cnum
-                  (string-to-int
-                   (substring position (match-beginning 2) (match-end 2))))))
-            ;; display the result
-            (goto-char start)
-            (ocamlspot-display-spot-overlay target-buffer start end)
-            )))))
+      (let ((target-buffer (ocamlspot-find-file-existing filename)))
+        (ocamlspot-display-overlay target-buffer position ocamlspot-spot-overlay)))))
 
 (defun ocamlspot-query ()
   (interactive)