Commits

Stephen Weeks  committed d83713c

Switched back to ocamlspot.el that we use with OCaml 3.12.1. We need a way to support
multiple OCaml versions in the same emacs with a single ocamlspot.el.

  • Participants
  • Parent commits ec3b807

Comments (0)

Files changed (1)

File elisp/contrib/ocamlspot.el

 ;
 ; Write the following to your .emacs
 
-; CR jfuruse: no tree node found is displayed when ocamlspot program is not found
+
 
 ;; load-path
 ; (setq load-path (cons "WHERE-YOU-HAVE-INSTALLED-THE-ELISP" load-path))
 ;            (local-set-key "\C-c\C-t" 'ocamlspot-type)
 ;            (local-set-key "\C-c\C-i" 'ocamlspot-xtype)
 ;            (local-set-key "\C-c\C-y" 'ocamlspot-type-and-copy)
-;            (local-set-key "\C-cx" 'ocamlspot-expand)
 ;            (local-set-key "\C-c\C-u" 'ocamlspot-use)
-;            (local-set-key "\C-ct" 'caml-types-show-type)
-;            (local-set-key "\C-cp" 'ocamlspot-pop-jump-stack)))
+;            (local-set-key "\C-ct" 'caml-types-show-type)))
 ;
 ;; You can also change overlay colors as follows:
 ; (set-face-background 'ocamlspot-spot-face "#660000")
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Constants
 
-;; Buffer names
-
 (defconst ocamlspot-process-buffer "*ocamlspot-process*"
   "The name of ocamlspot communication buffer")
 
 (defconst ocamlspot-type-buffer "*ocamlspot-type*"
   "The name of ocamlspot type buffer")
 
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ocamlspot-path
+
+; ocamlspot-path is superceded by ocamlspot-command, but if it exists,
+; it overrides ocamlspot-command
+
+(defun ocamlspot-get-command ()
+  (if (boundp 'ocamlspot-path) ocamlspot-path ocamlspot-command))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; column chars => column bytes
 
-;; This looks complicated, but we need this conversion for multi-byte characters
-;; OCaml's colmuns are in bytes, but Emacs's columns are in chars.
+; This looks complicated, but we need this conversion for multi-byte characters
 
-;; returns string from the beginning of the line at the point to the point.
 (defun ocamlspot-string-of-line-to-point ()
   (buffer-substring-no-properties
    (line-beginning-position) (point)))
 
-;; returns byte length from the beginning of the line at the point to the point.
 (defun ocamlspot-bytes-of-line-to-point ()
   (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.
+; 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) (min (1+ (point)) (point-max))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; column bytes => column chars
 
-;; This looks complicated, but we need this conversion for multi-byte characters
+; This looks complicated, but we need this conversion for multi-byte characters
 
-;; Same as (goto-line), but without unwanted side-effects.
+; goto-line set mark and we see the result in the minibuffer
 (defun ocamlspot-goto-line (line)
   (goto-char (point-min))
   (forward-line (1- line)))
 
-;; returns the string at line
+;; get the string at line
 (defun ocamlspot-buffer-substring-at-line (line)
   ; no need of save-excursion
   (ocamlspot-goto-line line)
   (buffer-substring-no-properties (line-beginning-position)
                                   (line-end-position)))
 
-;; returns the first [bytes] of [str] as chars, not as bytes
 (defun ocamlspot-chars-of-bytes-of-string (str bytes)
   (length
    (decode-coding-string
                0 bytes)
     buffer-file-coding-system)))
 
-;; returns the buffer position of [bytes] at [line]
 (defun ocamlspot-pos-of-bytes-at-line (line bytes)
   ; no need of save-excursion
   (ocamlspot-goto-line line)
             (bytes (string-to-number (match-string 3 s))))
         (list line colbytes bytes))))
 
-;; convert lxxxxcxxxxbxxxx to its buffer position
 (defun ocamlspot-pos-of-location (buffer s)
   (destructuring-bind (line colbytes bytes) (ocamlspot-parse-location s)
     (if (= line -1) bytes
 
 (setq ocamlspot-message-file-name nil) ;; only used for xtype
 
-;; Clean the message buffer, and set the context file name
 (defun ocamlspot-message-init (context-file-name)
   (setq ocamlspot-message-file-name context-file-name)
   (with-current-buffer (get-buffer-create ocamlspot-message-buffer)
     (erase-buffer)))
 
-;; Add a message to the message buffer
 (defun ocamlspot-message-add (mes)
   (with-current-buffer (get-buffer-create ocamlspot-message-buffer)
     (if (/= 0 (current-column))
         (insert "\n"))
     (insert mes)))
 
-;; Display message in the echo area if it is enough short, then return the string.
-;; If too large, pop a buffer of the message if may-pop is t and return the buffer.
-;; Otherwise, returns nil
+; Display message in the echo area if it is enough short, then return the string.
+; If too large, pop a buffer of the message if may-pop is t and return the buffer.
+; Otherwise, returns nil
 (defun ocamlspot-message-display (&optional may-pop)
   (with-current-buffer (get-buffer-create ocamlspot-message-buffer)
     (let ((lines ; how many lines in minibuffer-window ? 
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; type buffer
 
-;; Clean the type buffer
 (defun ocamlspot-type-init ()
   (with-current-buffer (get-buffer-create ocamlspot-type-buffer)
     (erase-buffer)
     (ocamlspot-xtype-mode t)))
 
-;; Add message to the type buffer
 (defun ocamlspot-type-add (mes)
   (with-current-buffer (get-buffer-create ocamlspot-type-buffer)
     (if (/= 0 (current-column))
   :group 'ocamlspot)
 (overlay-put ocamlspot-tree-overlay 'face 'ocamlspot-tree-face)
 
-;; Clear the overlay 
 (defun ocamlspot-delete-overlays-now ()
   (interactive)
   (delete-overlay ocamlspot-tree-overlay)
   (delete-overlay ocamlspot-spot-overlay))
 
-;; Clear the overlay, waiting 10 secs maximum
 (defun ocamlspot-delete-overlays ()
   (unwind-protect
       (sit-for 10)
     (ocamlspot-delete-overlays-now)))
 
-;; Parse ocamlspot region string
-;; Acceptable forms: all | lxxxcxxxbxxx:lyyycyyybyyy | xxx:yyy
-(defun ocamlspot-convert-region (buffer position)
-  (if (not buffer) (error "ocamlspot-convert-region: buffer is nill")
-    (save-current-buffer
-      (set-buffer buffer)
-      (if (or (string-equal "all" position) (string-equal "-1:-1" position))
-	  (list (point-min) (point-max))
-	(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 (match-string 1 position))
-		  (end   (match-string 2 position)))
-	      (let ((start (ocamlspot-pos-of-location buffer start))
-		    (end   (ocamlspot-pos-of-location buffer end)))
-		(list start end)))
-	  nil)))))
-
-(defun ocamlspot-display-overlay (buffer emacs-start-end overlay)
-  (if emacs-start-end
-      (progn
-	(destructuring-bind (start end) emacs-start-end
-	  ;; display the result
-	  (set-buffer buffer)
-	  (goto-char start)
-	  (move-overlay overlay start end buffer)))
-    (message "ocamlspot-display-overlay: strange region")))
+(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 (match-string 1 position))
+            (end   (match-string 2 position)))
+        (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
+    (display-buffer buffer)
+    (move-overlay overlay (point-min) (point-max) buffer)))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Warnings
 
-;; Search a warning from the current point
 (defun ocamlspot-warning ()
   (and (re-search-forward "^\\(Warning: .*\\)$" nil t)
        (match-string 1)))
 
-;; Search the warnings from the current point, and returns them in reversed order
 (defun ocamlspot-warnings-rev (lst)
   (let ((warning (ocamlspot-warning)))
     (if warning (ocamlspot-warnings-rev (concat lst warning "\n"))
       lst)))
 
-;; Search the warnings from the current point
 (defun ocamlspot-warnings ()
   (goto-char (point-min))
   (ocamlspot-warnings-rev ""))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; File access
 
-;; Open the file, if exists
 (defun ocamlspot-find-file-existing (path)
   (if (file-exists-p path)
       (find-file-other-window path)
-    (ocamlspot-message-add (format "ERROR: source file %s was not found" path))
-    (error (format "ERROR: source file %s was not found" path))))
+    (ocamlspot-message-add (format "ERROR: source file %s was not found" path))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Queries
 
-;; Run ocamlspot command with args, possibly in the given directory.
 (defun ocamlspot-run-query (args &optional chdir)
   (with-current-buffer (get-buffer-create ocamlspot-process-buffer)
     (ocamlspot-process-mode t)
     (erase-buffer)
-    (insert (mapconcat 'identity (cons ocamlspot-command args) " "))
-    (insert "\n")
-    ;; chdir is required
-    (if chdir (cd chdir))
-    (let ((args (if ocamlspot-debug (cons "--debug" args) args)))
-      (print (append '(call-process ocamlspot-command nil t nil) args))
-      (eval (append '(call-process ocamlspot-command nil t nil) args)))))
+    (let ((command (concat (ocamlspot-get-command) " " args)))
+      (insert command)
+      (insert "\n")
+      ;; chdir is required
+      (if chdir (cd chdir))
+      (let ((args (if ocamlspot-debug (concat "-debug " args) args)))
+	(call-process shell-file-name nil t nil shell-command-switch
+		      command)))))
 
-;; Creates the query location string of the point
 (defun ocamlspot-query-string-at-cursor ()
   (format "%s:l%dc%d"
 	  (buffer-file-name)
 	  (ocamlspot-lines-of-point)
 	  (ocamlspot-bytes-of-line-to-point)))
 
-;; launch ocamlspot, using the position of the cursor
-;; result is stored in the buffer "ocamlspot-process-buffer"
-;; the current buffer is stored in source-buffer
+; launch ocamlspot, using the position of the cursor
+; result is stored in the buffer "ocamlspot-process-buffer"
+; the current buffer is stored in source-buffer
 (defun ocamlspot-query-at-cursor (pre_extra_args &optional post_extra_args)
   ;; arguments
   (let ((file-name (buffer-file-name))
-	(arg (ocamlspot-query-string-at-cursor)))
-    (ocamlspot-run-query (append pre_extra_args (list arg) post_extra_args)
+	(arg (ocamlspot-query-string-at-cursor))
+	(post_sep (if post_extra_args " " "")))
+    (ocamlspot-run-query (concat pre_extra_args " " arg post_sep post_extra_args) 
 			 (file-name-directory file-name))))
 
-;; Search ocamlspot-process-buffer from the top and return the first line which matches with ^<pattern>: "
-;; If [to-kill], the output is copied to the kill-buffer.
+;;; Search ocamlspot-process-buffer and return the first line which matches with ^<pattern>: "
 (defun ocamlspot-find-query-result (pattern &optional to-kill)
-  (save-current-buffer
-    (set-buffer (get-buffer-create ocamlspot-process-buffer))
-    (goto-char (point-min))
-    (if (re-search-forward (concat "^" pattern ": \\(.*\\(\n +.*\\)*\\)") nil t)
-	(let ((the-match (match-string 1)))
-	  (if to-kill (kill-new the-match))
-	  the-match))))
+  (set-buffer (get-buffer-create ocamlspot-process-buffer))
+  (goto-char (point-min))
+  (if (re-search-forward (concat "^" pattern ": \\(.*\\(\n +.*\\)*\\)") nil t)
+      (let ((the-match (match-string 1)))
+        (if to-kill (kill-new the-match))
+        the-match)))
 
-;; Scan the ocamlspot process output and search a Tree tag.
-;; If there is a Tree result, highlight it and returns the position string
+;; Scan the ocamlspot process output and search Tree.
+;; If there is a Tree result, highlight it and returns t
 ;; Otherwise returns nil.
 (defun ocamlspot-find-tree ()
   (save-excursion
 	;; search the found tree element
 	(let ((tree (ocamlspot-find-query-result "Tree")))
 	  (if tree 
-	      (progn
-		(let ((start-end (ocamlspot-convert-region source-buffer tree)))
-		  (if start-end
-		      (save-current-buffer
-			(ocamlspot-display-overlay source-buffer start-end ocamlspot-tree-overlay)))
-		  (let ((err (ocamlspot-find-query-result "Error")))
-		    (if err
-			(ocamlspot-message-add (concat "Error: " err))))
-		  start-end))
+	      (if (string-match "^\\(l[\-0-9]+c[\-0-9]+b[\-0-9]+:l[\-0-9]+c[\-0-9]+b[\-0-9]+\\|[0-9]+:[0-9]+\\)$" tree)
+		  (let ((pos (match-string 1 tree)))
+		    ;; display the result
+		    (save-current-buffer
+		      (ocamlspot-display-overlay source-buffer pos ocamlspot-tree-overlay))
+		    (ocamlspot-message-add (ocamlspot-warnings))
+		    t))
+	    (let ((err (ocamlspot-find-query-result "Error")))
+		(if err
+		    (ocamlspot-message-add (concat "Error: " err))
+		  (ocamlspot-message-add "Error: no tree node found there")))
+	    nil
+	  ))))))
 
-	    (let ((err (ocamlspot-find-query-result "Error")))
-	      (if err
-		  (ocamlspot-message-add (concat "Error: " err))
-		(ocamlspot-message-add "Error: no tree node found there")))
-	    nil))))))
-
-;; Jump to [position] of [filename], with highlighting the spot overlay
 (defun ocamlspot-jump-to-spot (filename position)
   (if (string-match "\.cm[ioxa]$" filename)
       ;; It is not an .ml or .mli. Packed module.
       ;; CR jfuruse: opening a binary file is not good
-      (ocamlspot-message-add (format "Packed module: %s" filename))
-    (let* ((buffer (ocamlspot-find-file-existing filename))
-	   (start-end (ocamlspot-convert-region buffer position)))
-      (if start-end
-	  (ocamlspot-display-overlay buffer start-end ocamlspot-spot-overlay)
-	  (ocamlspot-message-add (concat "Error: strange position: " position))))))
+      (ocamlspot-message-add "Packed module: %s" filename)
+    (ocamlspot-display-overlay
+     (ocamlspot-find-file-existing filename)
+     position ocamlspot-spot-overlay)))
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Jump history
-
-;; Experimental. Jump back to the latest query position.
-
-(setq ocamlspot-jump-stack nil)
-
-(defun ocamlspot-pop-jump-stack ()
-  (interactive)
-  (if ocamlspot-jump-stack
-      (progn
-	(destructuring-bind (buffer pos) (car ocamlspot-jump-stack)
-	  (setq ocamlspot-jump-stack (cdr ocamlspot-jump-stack))
-	  (if (buffer-live-p buffer)
-	      (progn
-		(display-buffer buffer)
-		(switch-to-buffer buffer)
-		(goto-char pos))
-	    (ocamlspot-pop-jump-stack))))
-    (message "OCamlSpot jump stack is empty")))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Find-and-do-somethings. Query must be already done.
-
-;; Jump to given path-range.
 (defun ocamlspot-jump-to-path-range (path-range)
-  (if (string-match "^<?\\(.*\\):\\(all\\|[\-0-9lcb]+:[\-0-9lcb]+[^>]*\\)>?$" path-range)
+  (if (string-match "^<?\\(.*\\):\\(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\\)>?$" path-range)
       (let ((filename (match-string 1 path-range))
 	    (position (match-string 2 path-range)))
-	;; preserve current buffer and pos ;; CR jfuruse: history preserving should take occur only when the jump is successful.
-	(setq ocamlspot-jump-stack (cons (list (current-buffer)
-					       (point))
-					 ocamlspot-jump-stack))
-
 	;; display the result
 	(ocamlspot-jump-to-spot filename position)
 	(let ((type (ocamlspot-find-val-or-type)))
 	  ;; (if type (ocamlspot-message-add (format "Type: %s" type)))
 	  ))
     ;; failed to get the normal result
-    ;; This can be: Spot: %a: predefined %s
+    ;; CR jfuruse: this is an error message. Should be decolated?
     (ocamlspot-message-add path-range)))
 
-;; Show the type information
-;; If [to-kill], the output is copied to the kill-buffer.
 (defun ocamlspot-find-type (&optional to-kill)
   (let ((type (ocamlspot-find-query-result "Type" to-kill)))
     (if type 
 	  (ocamlspot-message-add (format "Type: %s" type))
 	  (ocamlspot-type-add (format "Type: %s" type))
 	  type)
-      (ocamlspot-message-add "No type found")
+      (ocamlspot-message-add "no type found here")
       nil)))
 
 ;; same as type-in-buffer but for XType
 	  (ocamlspot-type-add (format "(* %s *)\n" ocamlspot-message-file-name))
 	  (ocamlspot-type-add (format "%s" type))
 	  type)
-      (ocamlspot-message-add "No type found")
+      (ocamlspot-message-add "no type found here")
       nil)))
 
-;; If [to-kill], the output is copied to the kill-buffer.
 (defun ocamlspot-find-val-or-type (&optional to-kill)
   (let ((type (ocamlspot-find-query-result "Val" to-kill)))
     (if type
 	  type)
       (ocamlspot-find-type to-kill))))
 
-;; Show use info
 (defun ocamlspot-find-use ()
   (let ((use (ocamlspot-find-query-result "Use")))
     (if use
       (ocamlspot-message-add "no use information found here")
       nil)))
 
-;; Jump to the position found at the Spot tag
 (defun ocamlspot-find-spot ()
   (let ((spot (ocamlspot-find-query-result "Spot")))
     (if spot (ocamlspot-jump-to-path-range spot)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Interactives
 
-;; Show the message, and wait at most 10secs, then clear the overlay highlights
 (defun ocamlspot-wait (&optional may-pop)
   (ocamlspot-message-display may-pop)
   (ocamlspot-delete-overlays))
   (interactive)
   (ocamlspot-query "--interface"))
 
-;; Query the type at the point and show it. 
-;; If [to-kill] is t, the type string is copied to the kill buffer.
 (defun ocamlspot-type (&optional to-kill)
   (interactive)
   (ocamlspot-message-init (buffer-file-name))
   (ocamlspot-type-init)
   (ocamlspot-delete-overlays-now)
-  (ocamlspot-query-at-cursor '("-n"))  
+  (ocamlspot-query-at-cursor "-n")  
   (if (ocamlspot-find-tree)
       (save-current-buffer
         (ocamlspot-find-val-or-type to-kill)))
   (ocamlspot-message-init (buffer-file-name))
   (ocamlspot-type-init)
   (ocamlspot-delete-overlays-now)
-  (ocamlspot-query-at-cursor '("-n"))
+  (ocamlspot-query-at-cursor "-n")
   (if (ocamlspot-find-tree)
       (save-current-buffer
         (ocamlspot-find-xtype)))
   (ocamlspot-message-init (buffer-file-name))
   (ocamlspot-type-init)
   (ocamlspot-delete-overlays-now)
-  (ocamlspot-query-at-cursor '("-n"))
+  (ocamlspot-query-at-cursor "-n")
   (if (ocamlspot-find-tree)
       (save-current-buffer
         (ocamlspot-find-use)))
     (ocamlspot-message-init (buffer-file-name))
     (ocamlspot-type-init)
     (ocamlspot-delete-overlays-now)
-    (ocamlspot-query-at-cursor '("use" dir))
+    (ocamlspot-query-at-cursor "use" dir)
     (if (ocamlspot-find-tree)
 	(progn
 	 (ocamlspot-find-spot)
 	 (ocamlspot-find-use)))
     (ocamlspot-wait t)))
 
-; ;; expand expr/pattern by type
-(defun ocamlspot-expand ()
-  (interactive)
-  (ocamlspot-message-init (buffer-file-name))
-  (ocamlspot-type-init)
-  (ocamlspot-query-at-cursor '("-n --type-expand"))
-  (let ((expansion (ocamlspot-find-query-result "Expand")))
-    (if expansion
-	(let ((start-end (ocamlspot-find-tree)))
-	  (if start-end
-	      (destructuring-bind (start end) start-end
-                (ocamlspot-delete-overlays-now)
-		(delete-region start end) ; or kill-region ?
-		(goto-char start)
-		(insert expansion)
-		(let ((new-end (point)))
-		  (ocamlspot-display-overlay (current-buffer) (list start new-end) ocamlspot-tree-overlay))
-		(ocamlspot-delete-overlays)
-		)
-	    (ocamlspot-message-add "OCamlSpot -expand: no tree information found")))
-      (ocamlspot-message-add "OCamlSpot -expand: no expand information found"))))
-	
 ;; Browsing of path-range <file:lxcxbx:lxcxbx>
 (defun ocamlspot-beginning-of-path-range ()
   (search-backward "<"
 	(if query
 	    (progn
 	      (message query)
-	      (ocamlspot-run-query '(query))
+	      (ocamlspot-run-query query)
 	      (ocamlspot-find-spot)
 	      (ocamlspot-wait))
 	  (message "query empty"))))