ocaml / camldebug.el

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
;;; Run camldebug under Emacs
;;; Derived from gdb.el.
;;; gdb.el is Copyright (C) 1988 Free Software Foundation, Inc, and is part
;;; of GNU Emacs
;;; Modified by Jerome Vouillon, 1994.
;;; Modified by Ian T. Zimmerman, 1996.
;;; Modified by Xavier Leroy, 1997.

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 1, or (at your option)
;; any later version.

;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;;itz 04-06-96 I pondered basing this on gud. The potential advantages
;;were: automatic bugfix , keymaps and menus propagation.
;;Disadvantages: gud is not so clean itself, there is little common
;;functionality it abstracts (most of the stuff is done in the
;;debugger specific parts anyway), and, most seriously, gud sees it
;;fit to add C-x C-a bindings to the _global_ map, so there would be a
;;conflict between camldebug and gdb, for instance. While it's OK to
;;assume that a sane person doesn't use gdb and dbx at the same time,
;;it's not so OK (IMHO) for gdb and camldebug.

;; Xavier Leroy, 21/02/97: adaptation to ocamldebug.

(require 'comint)
(require 'shell)
(require 'caml)
(require 'derived)
(require 'thingatpt)

;;; Variables.

(defvar camldebug-last-frame)
(defvar camldebug-delete-prompt-marker)
(defvar camldebug-filter-accumulator nil)
(defvar camldebug-last-frame-displayed-p)
(defvar camldebug-filter-function)

(defvar camldebug-prompt-pattern "^(ocd) *"
  "A regexp to recognize the prompt for ocamldebug.")

(defvar camldebug-overlay-event nil
  "Overlay for displaying the current event.")
(defvar camldebug-overlay-under nil
  "Overlay for displaying the current event.")
(defvar camldebug-event-marker nil
  "Marker for displaying the current event.")

(defvar camldebug-track-frame t
  "*If non-nil, always display current frame position in another window.")

(cond
 (window-system
  (make-face 'camldebug-event)
  (make-face 'camldebug-underline)
  (if (not (face-differs-from-default-p 'camldebug-event))
      (invert-face 'camldebug-event))
  (if (not (face-differs-from-default-p 'camldebug-underline))
      (set-face-underline-p 'camldebug-underline t))
  (setq camldebug-overlay-event (make-overlay 1 1))
  (overlay-put camldebug-overlay-event 'face 'camldebug-event)
  (setq camldebug-overlay-under (make-overlay 1 1))
  (overlay-put camldebug-overlay-under 'face 'camldebug-underline))
 (t
  (setq camldebug-event-marker (make-marker))
  (setq overlay-arrow-string "=>")))

;;; Camldebug mode.

(define-derived-mode camldebug-mode comint-mode "Inferior CDB"

  "Major mode for interacting with an inferior Camldebug process.

The following commands are available:

\\{camldebug-mode-map}

\\[camldebug-display-frame] displays in the other window
the last line referred to in the camldebug buffer.

\\[camldebug-step], \\[camldebug-back] and \\[camldebug-next], in the camldebug window,
call camldebug to step, backstep or next and then update the other window
with the current file and position.

If you are in a source file, you may select a point to break
at, by doing \\[camldebug-break].

Commands:
Many commands are inherited from comint mode.
Additionally we have:

\\[camldebug-display-frame] display frames file in other window
\\[camldebug-step] advance one line in program
C-x SPACE sets break point at current line."

  (mapcar 'make-local-variable
          '(camldebug-last-frame-displayed-p  camldebug-last-frame
            camldebug-delete-prompt-marker camldebug-filter-function
           camldebug-filter-accumulator paragraph-start))
  (setq
   camldebug-last-frame nil
   camldebug-delete-prompt-marker (make-marker)
   camldebug-filter-accumulator ""
   camldebug-filter-function 'camldebug-marker-filter
   comint-prompt-regexp camldebug-prompt-pattern
   comint-dynamic-complete-functions (cons 'camldebug-complete
                                           comint-dynamic-complete-functions)
   paragraph-start comint-prompt-regexp
   camldebug-last-frame-displayed-p t)
  (make-local-variable 'shell-dirtrackp)
  (setq shell-dirtrackp t)
  (setq comint-input-sentinel 'shell-directory-tracker))

;;; Keymaps.

(defun camldebug-numeric-arg (arg)
  (and arg (prefix-numeric-value arg)))

(defmacro def-camldebug (name key &optional doc args)

  "Define camldebug-NAME to be a command sending NAME ARGS and bound
to KEY, with optional doc string DOC.  Certain %-escapes in ARGS are
interpreted specially if present.  These are:

  %m    module name of current module.
  %d    directory of current source file.
  %c    number of current character position
  %e    text of the caml variable surrounding point.

  The `current' source file is the file of the current buffer (if
we're in a caml buffer) or the source file current at the last break
or step (if we're in the camldebug buffer), and the `current' module
name is the filename stripped of any *.ml* suffixes (this assumes the
usual correspondence between module and file naming is observed).  The
`current' position is that of the current buffer (if we're in a source
file) or the position of the last break or step (if we're in the
camldebug buffer).

If a numeric is present, it overrides any ARGS flags and its string
representation is simply concatenated with the COMMAND."

  (let* ((fun (intern (format "camldebug-%s" name))))
    (list 'progn
          (if doc
              (list 'defun fun '(arg)
                    doc
                    '(interactive "P")
                    (list 'camldebug-call name args
                          '(camldebug-numeric-arg arg))))
          (list 'define-key 'camldebug-mode-map
                (concat "\C-c" key)
                (list 'quote fun))
          (list 'define-key 'caml-mode-map
                (concat "\C-x\C-a" key)
                (list 'quote fun)))))

(def-camldebug "step"   "\C-s"  "Step one event forward.")
(def-camldebug "backstep" "\C-k" "Step one event backward.")
(def-camldebug "run"    "\C-r"  "Run the program.")
(def-camldebug "reverse" "\C-v" "Run the program in reverse.")
(def-camldebug "last"   "\C-l"  "Go to latest time in execution history.")
(def-camldebug "backtrace" "\C-t" "Print the call stack.")
(def-camldebug "finish" "\C-f"  "Finish executing current function.")
(def-camldebug "print"  "\C-p"  "Print value of symbol at point."       "%e")
(def-camldebug "display" "\C-d" "Display value of symbol at point."     "%e")
(def-camldebug "next"   "\C-n"  "Step one event forward (skip functions)")
(def-camldebug "up"     "<"  "Go up N stack frames (numeric arg) with display")
(def-camldebug "down"  ">" "Go down N stack frames (numeric arg) with display")
(def-camldebug "break"  "\C-b"  "Set breakpoint at current line."
  "@ \"%m\" # %c")

(defun camldebug-mouse-display (click)
  "Display value of $NNN clicked on."
  (interactive "e")
  (let* ((start (event-start click))
         (window (car start))
         (pos (car (cdr start)))
         symb)
    (save-excursion
      (select-window window)
      (goto-char pos)
      (setq symb (thing-at-point 'symbol))
      (if (string-match "^\\$[0-9]+$" symb)
          (camldebug-call "display" symb)))))

(define-key camldebug-mode-map [mouse-2] 'camldebug-mouse-display)

(defun camldebug-kill-filter (string)
  ;gob up stupid questions :-)
  (setq camldebug-filter-accumulator
        (concat camldebug-filter-accumulator string))
  (if (not (string-match "\\(.* \\)(y or n) "
                         camldebug-filter-accumulator)) nil
    (setq camldebug-kill-output
          (cons t (match-string 1 camldebug-filter-accumulator)))
    (setq camldebug-filter-accumulator ""))
  (if (string-match comint-prompt-regexp camldebug-filter-accumulator)
      (let ((output (substring camldebug-filter-accumulator
                               (match-beginning 0))))
        (setq camldebug-kill-output
              (cons nil (substring camldebug-filter-accumulator 0
                                   (1- (match-beginning 0)))))
        (setq camldebug-filter-accumulator "")
        output)
    ""))

(def-camldebug "kill"   "\C-k")

(defun camldebug-kill ()
  "Kill the program."
  (interactive)
  (let ((camldebug-kill-output))
    (save-excursion
      (set-buffer current-camldebug-buffer)
      (let ((proc (get-buffer-process (current-buffer)))
            (camldebug-filter-function 'camldebug-kill-filter))
        (camldebug-call "kill")
        (while (not (and camldebug-kill-output
                         (zerop (length camldebug-filter-accumulator))))
          (accept-process-output proc))))
    (if (not (car camldebug-kill-output))
        (error (cdr camldebug-kill-output))
      (sit-for 0 300)
      (camldebug-call-1 (if (y-or-n-p (cdr camldebug-kill-output)) "y" "n")))))
;;FIXME: camldebug doesn't output the Hide marker on kill

(defun camldebug-goto-filter (string)
  ;accumulate onto previous output
  (setq camldebug-filter-accumulator
        (concat camldebug-filter-accumulator string))
  (if (not (string-match (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+"
                          camldebug-goto-position
                          "[ \t]*\\(before\\|after\\)\n")
                  camldebug-filter-accumulator)) nil
    (setq camldebug-goto-output
          (match-string 2 camldebug-filter-accumulator))
    (setq camldebug-filter-accumulator
          (substring camldebug-filter-accumulator (1- (match-end 0)))))
  (if (not (string-match comint-prompt-regexp
                         camldebug-filter-accumulator)) nil
    (setq camldebug-goto-output (or camldebug-goto-output 'fail))
    (setq camldebug-filter-accumulator ""))
  (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator)
      (setq camldebug-filter-accumulator
            (match-string 1 camldebug-filter-accumulator)))
  "")

(def-camldebug "goto" "\C-g")
(defun camldebug-goto (&optional time)

  "Go to the execution time TIME.

Without TIME, the command behaves as follows: In the camldebug buffer,
if the point at buffer end, goto time 0\; otherwise, try to obtain the
time from context around point. In a caml mode buffer, try to find the
time associated in execution history with the current point location.

With a negative TIME, move that many lines backward in the camldebug
buffer, then try to obtain the time from context around point."

  (interactive "P")
  (cond
   (time
    (let ((ntime (camldebug-numeric-arg time)))
      (if (>= ntime 0) (camldebug-call "goto" nil ntime)
        (save-selected-window
          (select-window (get-buffer-window current-camldebug-buffer))
          (save-excursion
            (if (re-search-backward "^Time : [0-9]+ - pc : [0-9]+ "
                                    nil t (- 1 ntime))
                (camldebug-goto nil)
              (error "I don't have %d times in my history"
                     (- 1 ntime))))))))
   ((eq (current-buffer) current-camldebug-buffer)
      (let ((time (cond
                   ((eobp) 0)
                   ((save-excursion
                      (beginning-of-line 1)
                      (looking-at "^Time : \\([0-9]+\\) - pc : [0-9]+ "))
                    (string-to-int (match-string 1)))
                   ((string-to-int (camldebug-format-command "%e"))))))
        (camldebug-call "goto" nil time)))
   (t
    (let ((module (camldebug-module-name (buffer-file-name)))
          (camldebug-goto-position (int-to-string (1- (point))))
          (camldebug-goto-output) (address))
      ;get a list of all events in the current module
      (save-excursion
        (set-buffer current-camldebug-buffer)
        (let* ((proc (get-buffer-process (current-buffer)))
               (camldebug-filter-function 'camldebug-goto-filter))
          (camldebug-call-1 (concat "info events " module))
          (while (not (and camldebug-goto-output
                      (zerop (length camldebug-filter-accumulator))))
            (accept-process-output proc))
          (setq address (if (eq camldebug-goto-output 'fail) nil
                          (re-search-backward
                           (concat "^Time : \\([0-9]+\\) - pc : "
                                   camldebug-goto-output
                                   " - module "
                                   module "$") nil t)
                          (match-string 1)))))
      (if address (camldebug-call "goto" nil (string-to-int address))
        (error "No time at %s at %s" module camldebug-goto-position))))))


(defun camldebug-delete-filter (string)
  (setq camldebug-filter-accumulator
        (concat camldebug-filter-accumulator string))
  (if (not (string-match
            (concat "\\(\n\\|\\`\\)[ \t]*\\([0-9]+\\)[ \t]+[0-9]+[ \t]*in "
                    (regexp-quote camldebug-delete-file)
                    ", character "
                    camldebug-delete-position "\n")
                  camldebug-filter-accumulator)) nil
    (setq camldebug-delete-output
          (match-string 2 camldebug-filter-accumulator))
    (setq camldebug-filter-accumulator
          (substring camldebug-filter-accumulator (1- (match-end 0)))))
  (if (not (string-match comint-prompt-regexp
                         camldebug-filter-accumulator)) nil
    (setq camldebug-delete-output (or camldebug-delete-output 'fail))
    (setq camldebug-filter-accumulator ""))
  (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator)
      (setq camldebug-filter-accumulator
            (match-string 1 camldebug-filter-accumulator)))
  "")


(def-camldebug "delete" "\C-d")

(defun camldebug-delete (&optional arg)
  "Delete the breakpoint numbered ARG.

Without ARG, the command behaves as follows: In the camldebug buffer,
try to obtain the time from context around point. In a caml mode
buffer, try to find the breakpoint associated with the current point
location.

With a negative ARG, look for the -ARGth breakpoint pattern in the
camldebug buffer, then try to obtain the breakpoint info from context
around point."

  (interactive "P")
  (cond
   (arg
    (let ((narg (camldebug-numeric-arg arg)))
      (if (> narg 0) (camldebug-call "delete" nil narg)
        (save-excursion
          (set-buffer current-camldebug-buffer)
          (if (re-search-backward "^Breakpoint [0-9]+ at [0-9]+ : file "
                                  nil t (- 1 narg))
              (camldebug-delete nil)
            (error "I don't have %d breakpoints in my history"
                     (- 1 narg)))))))
   ((eq (current-buffer) current-camldebug-buffer)
    (let* ((bpline "^Breakpoint \\([0-9]+\\) at [0-9]+ : file ")
           (arg (cond
                 ((eobp)
                  (save-excursion (re-search-backward bpline nil t))
                  (string-to-int (match-string 1)))
                 ((save-excursion
                    (beginning-of-line 1)
                    (looking-at bpline))
                  (string-to-int (match-string 1)))
                 ((string-to-int (camldebug-format-command "%e"))))))
      (camldebug-call "delete" nil arg)))
   (t
    (let ((camldebug-delete-file
           (concat (camldebug-format-command "%m") ".ml"))
          (camldebug-delete-position (camldebug-format-command "%c")))
      (save-excursion
        (set-buffer current-camldebug-buffer)
        (let ((proc (get-buffer-process (current-buffer)))
              (camldebug-filter-function 'camldebug-delete-filter)
              (camldebug-delete-output))
          (camldebug-call-1 "info break")
          (while (not (and camldebug-delete-output
                           (zerop (length
                                   camldebug-filter-accumulator))))
            (accept-process-output proc))
          (if (eq camldebug-delete-output 'fail)
              (error "No breakpoint in %s at %s"
                     camldebug-delete-file
                     camldebug-delete-position)
            (camldebug-call "delete" nil
                            (string-to-int camldebug-delete-output)))))))))

(defun camldebug-complete-filter (string)
  (setq camldebug-filter-accumulator
        (concat camldebug-filter-accumulator string))
  (while (string-match "\\(\n\\|\\`\\)\\(.+\\)\n"
                       camldebug-filter-accumulator)
    (setq camldebug-complete-list
          (cons (match-string 2 camldebug-filter-accumulator)
                camldebug-complete-list))
    (setq camldebug-filter-accumulator
          (substring camldebug-filter-accumulator
                     (1- (match-end 0)))))
  (if (not (string-match comint-prompt-regexp
                         camldebug-filter-accumulator)) nil
    (setq camldebug-complete-list
          (or camldebug-complete-list 'fail))
    (setq camldebug-filter-accumulator ""))
  (if (string-match "\n\\(.*\\)\\'" camldebug-filter-accumulator)
      (setq camldebug-filter-accumulator
            (match-string 1 camldebug-filter-accumulator)))
  "")

(defun camldebug-complete ()

  "Perform completion on the camldebug command preceding point."

  (interactive)
  (let* ((end (point))
         (command (save-excursion
                    (beginning-of-line)
                    (and (looking-at comint-prompt-regexp)
                         (goto-char (match-end 0)))
                    (buffer-substring (point) end)))
         (camldebug-complete-list nil) (command-word))

    ;; Find the word break.  This match will always succeed.
    (string-match "\\(\\`\\| \\)\\([^ ]*\\)\\'" command)
    (setq command-word (match-string 2 command))

    ;itz 04-21-96 if we are trying to complete a word of nonzero
    ;length, chop off the last character. This is a nasty hack, but it
    ;works - in general, not just for this set of words: the comint
    ;call below will weed out false matches - and it avoids further
    ;mucking with camldebug's lexer.
    (if (> (length command-word) 0)
        (setq command (substring command 0 (1- (length command)))))

    (let ((camldebug-filter-function 'camldebug-complete-filter))
      (camldebug-call-1 (concat "complete " command))
      (set-marker camldebug-delete-prompt-marker nil)
      (while (not (and camldebug-complete-list
                       (zerop (length camldebug-filter-accumulator))))
        (accept-process-output (get-buffer-process
                                (current-buffer)))))
    (if (eq camldebug-complete-list 'fail)
        (setq camldebug-complete-list nil))
    (setq camldebug-complete-list
          (sort camldebug-complete-list 'string-lessp))
    (comint-dynamic-simple-complete command-word camldebug-complete-list)))

(define-key camldebug-mode-map "\C-l" 'camldebug-refresh)
(define-key camldebug-mode-map "\t" 'comint-dynamic-complete)
(define-key camldebug-mode-map "\M-?" 'comint-dynamic-list-completions)

(define-key caml-mode-map "\C-x " 'camldebug-break)


(defvar current-camldebug-buffer nil)


;;;###autoload
(defvar camldebug-command-name "ocamldebug"
  "Pathname for executing camldebug.")

;;;###autoload
(defun camldebug (path)
  "Run camldebug on program FILE in buffer *camldebug-FILE*.
The directory containing FILE becomes the initial working directory
and source-file directory for camldebug.  If you wish to change this, use
the camldebug commands `cd DIR' and `directory'."
  (interactive "fRun ocamldebug on file: ")
  (setq path (expand-file-name path))
  (let ((file (file-name-nondirectory path)))
    (pop-to-buffer (concat "*camldebug-" file "*"))
    (setq default-directory (file-name-directory path))
    (message "Current directory is %s" default-directory)
    (make-comint (concat "camldebug-" file)
                 (substitute-in-file-name camldebug-command-name)
                 nil
                 "-emacs" "-cd" default-directory file)
    (set-process-filter (get-buffer-process (current-buffer))
                        'camldebug-filter)
    (set-process-sentinel (get-buffer-process (current-buffer))
                          'camldebug-sentinel)
    (camldebug-mode)
    (camldebug-set-buffer)))

(defun camldebug-set-buffer ()
  (if (eq major-mode 'camldebug-mode)
      (setq current-camldebug-buffer (current-buffer))
    (save-selected-window (pop-to-buffer current-camldebug-buffer))))

;;; Filter and sentinel.

(defun camldebug-marker-filter (string)
  (setq camldebug-filter-accumulator
        (concat camldebug-filter-accumulator string))
  (let ((output "") (begin))
    ;; Process all the complete markers in this chunk.
    (while (setq begin
                 (string-match
                  "\032\032\\(H\\|M\\(.+\\):\\(.+\\):\\(before\\|after\\)\\)\n"
                  camldebug-filter-accumulator))
      (setq camldebug-last-frame
            (if (char-equal ?H (aref camldebug-filter-accumulator
                                     (1+ (1+ begin)))) nil
              (list (match-string 2 camldebug-filter-accumulator)
                    (string-to-int
                     (match-string 3 camldebug-filter-accumulator))
                    (string= "before"
                             (match-string 4
                                           camldebug-filter-accumulator))))
            output (concat output
                           (substring camldebug-filter-accumulator
                                      0 begin))
            ;; Set the accumulator to the remaining text.
            camldebug-filter-accumulator (substring
                                          camldebug-filter-accumulator
                                          (match-end 0))
            camldebug-last-frame-displayed-p nil))

    ;; Does the remaining text look like it might end with the
    ;; beginning of another marker?  If it does, then keep it in
    ;; camldebug-filter-accumulator until we receive the rest of it.  Since we
    ;; know the full marker regexp above failed, it's pretty simple to
    ;; test for marker starts.
    (if (string-match "\032.*\\'" camldebug-filter-accumulator)
        (progn
          ;; Everything before the potential marker start can be output.
          (setq output (concat output (substring camldebug-filter-accumulator
                                                 0 (match-beginning 0))))

          ;; Everything after, we save, to combine with later input.
          (setq camldebug-filter-accumulator
                (substring camldebug-filter-accumulator (match-beginning 0))))

      (setq output (concat output camldebug-filter-accumulator)
            camldebug-filter-accumulator ""))

    output))

(defun camldebug-filter (proc string)
  (let ((output))
    (if (buffer-name (process-buffer proc))
        (let ((process-window))
          (save-excursion
            (set-buffer (process-buffer proc))
            ;; If we have been so requested, delete the debugger prompt.
            (if (marker-buffer camldebug-delete-prompt-marker)
                (progn
                  (delete-region (process-mark proc)
                                 camldebug-delete-prompt-marker)
                  (set-marker camldebug-delete-prompt-marker nil)))
            (setq output (funcall camldebug-filter-function string))
            ;; Don't display the specified file unless
            ;; (1) point is at or after the position where output appears
            ;; and (2) this buffer is on the screen.
            (setq process-window (and camldebug-track-frame
                                      (not camldebug-last-frame-displayed-p)
                                      (>= (point) (process-mark proc))
                                      (get-buffer-window (current-buffer))))
            ;; Insert the text, moving the process-marker.
            (comint-output-filter proc output))
          (if process-window
              (save-selected-window
                (select-window process-window)
                (camldebug-display-frame)))))))

(defun camldebug-sentinel (proc msg)
  (cond ((null (buffer-name (process-buffer proc)))
         ;; buffer killed
         ;; Stop displaying an arrow in a source file.
         (camldebug-remove-current-event)
         (set-process-buffer proc nil))
        ((memq (process-status proc) '(signal exit))
         ;; Stop displaying an arrow in a source file.
         (camldebug-remove-current-event)
         ;; Fix the mode line.
         (setq mode-line-process
               (concat ": "
                       (symbol-name (process-status proc))))
         (let* ((obuf (current-buffer)))
           ;; save-excursion isn't the right thing if
           ;;  process-buffer is current-buffer
           (unwind-protect
               (progn
                 ;; Write something in *compilation* and hack its mode line,
                 (set-buffer (process-buffer proc))
                 ;; Force mode line redisplay soon
                 (set-buffer-modified-p (buffer-modified-p))
                 (if (eobp)
                     (insert ?\n mode-name " " msg)
                   (save-excursion
                     (goto-char (point-max))
                     (insert ?\n mode-name " " msg)))
                 ;; If buffer and mode line will show that the process
                 ;; is dead, we can delete it now.  Otherwise it
                 ;; will stay around until M-x list-processes.
                 (delete-process proc))
             ;; Restore old buffer, but don't restore old point
             ;; if obuf is the cdb buffer.
             (set-buffer obuf))))))


(defun camldebug-refresh (&optional arg)
  "Fix up a possibly garbled display, and redraw the mark."
  (interactive "P")
  (camldebug-display-frame)
  (recenter arg))

(defun camldebug-display-frame ()
  "Find, obey and delete the last filename-and-line marker from CDB.
The marker looks like \\032\\032FILENAME:CHARACTER\\n.
Obeying it means displaying in another window the specified file and line."
  (interactive)
  (camldebug-set-buffer)
  (if (not camldebug-last-frame)
      (camldebug-remove-current-event)
    (camldebug-display-line (car camldebug-last-frame)
                            (car (cdr camldebug-last-frame))
                            (car (cdr (cdr camldebug-last-frame)))))
  (setq camldebug-last-frame-displayed-p t))

;; Make sure the file named TRUE-FILE is in a buffer that appears on the screen
;; and that its character CHARACTER is visible.
;; Put the mark on this character in that buffer.

(defun camldebug-display-line (true-file character kind)
  (let* ((pre-display-buffer-function nil) ; screw it, put it all in one screen
         (pop-up-windows t)
         (buffer (find-file-noselect true-file))
         (window (display-buffer buffer t))
         (pos))
    (save-excursion
      (set-buffer buffer)
      (save-restriction
        (widen)
        (setq pos (+ (point-min) character))
        (camldebug-set-current-event pos (current-buffer) kind))
      (cond ((or (< pos (point-min)) (> pos (point-max)))
             (widen)
             (goto-char pos))))
    (set-window-point window pos)))

;;; Events.

(defun camldebug-remove-current-event ()
  (if window-system
      (progn
        (delete-overlay camldebug-overlay-event)
        (delete-overlay camldebug-overlay-under))
    (setq overlay-arrow-position nil)))

(defun camldebug-set-current-event (pos buffer before)
  (if window-system
      (if before
          (progn
            (move-overlay camldebug-overlay-event pos (1+ pos) buffer)
            (move-overlay camldebug-overlay-under
                          (+ pos 1) (+ pos 3) buffer))
        (move-overlay camldebug-overlay-event (1- pos) pos buffer)
        (move-overlay camldebug-overlay-under (- pos 3) (- pos 1) buffer))
    (save-excursion
      (set-buffer buffer)
      (goto-char pos)
      (beginning-of-line)
      (move-marker camldebug-event-marker (point))
      (setq overlay-arrow-position camldebug-event-marker))))

;;; Miscellaneous.

(defun camldebug-module-name (filename)
  (substring filename (string-match "\\([^/]*\\)\\.ml$" filename) (match-end 1)))

;;; The camldebug-call function must do the right thing whether its
;;; invoking keystroke is from the camldebug buffer itself (via
;;; major-mode binding) or a caml buffer.  In the former case, we want
;;; to supply data from camldebug-last-frame.  Here's how we do it:

(defun camldebug-format-command (str)
  (let* ((insource (not (eq (current-buffer) current-camldebug-buffer)))
        (frame (if insource nil camldebug-last-frame)) (result))
    (while (and str (string-match "\\([^%]*\\)%\\([mdcep]\\)" str))
      (let ((key (string-to-char (substring str (match-beginning 2))))
            (cmd (substring str (match-beginning 1) (match-end 1)))
            (subst))
        (setq str (substring str (match-end 2)))
        (cond
         ((eq key ?m)
          (setq subst (camldebug-module-name
                       (if insource (buffer-file-name) (nth 0 frame)))))
         ((eq key ?d)
          (setq subst (file-name-directory
                       (if insource (buffer-file-name) (nth 0 frame)))))
         ((eq key ?c)
          (setq subst (int-to-string
                       (if insource (1- (point)) (nth 1 frame)))))
         ((eq key ?e)
          (setq subst (thing-at-point 'symbol))))
        (setq result (concat result cmd subst))))
    ;; There might be text left in STR when the loop ends.
    (concat result str)))

(defun camldebug-call (command &optional fmt arg)
  "Invoke camldebug COMMAND displaying source in other window.

Certain %-escapes in FMT are interpreted specially if present.
These are:

  %m    module name of current module.
  %d    directory of current source file.
  %c    number of current character position
  %e    text of the caml variable surrounding point.

  The `current' source file is the file of the current buffer (if
we're in a caml buffer) or the source file current at the last break
or step (if we're in the camldebug buffer), and the `current' module
name is the filename stripped of any *.ml* suffixes (this assumes the
usual correspondence between module and file naming is observed).  The
`current' position is that of the current buffer (if we're in a source
file) or the position of the last break or step (if we're in the
camldebug buffer).

If ARG is present, it overrides any FMT flags and its string
representation is simply concatenated with the COMMAND."

  ;; Make sure debugger buffer is displayed in a window.
  (camldebug-set-buffer)
  (message "Command: %s" (camldebug-call-1 command fmt arg)))

(defun camldebug-call-1 (command &optional fmt arg)

  ;; Record info on the last prompt in the buffer and its position.
  (save-excursion
    (set-buffer current-camldebug-buffer)
    (goto-char (process-mark (get-buffer-process current-camldebug-buffer)))
    (let ((pt (point)))
      (beginning-of-line)
      (if (looking-at comint-prompt-regexp)
          (set-marker camldebug-delete-prompt-marker (point)))))
  (let ((cmd (cond
              (arg (concat command " " (int-to-string arg)))
              (fmt (camldebug-format-command
                    (concat command " " fmt)))
              (command))))
    (process-send-string (get-buffer-process current-camldebug-buffer)
                         (concat cmd "\n"))
    cmd))


(provide 'camldebug)
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.