(defvar gb/current-escape nil)
(make-variable-buffer-local 'gb/current-escape)
(set-default 'gb/current-escape nil)

(make-variable-buffer-local 'gb/extent-stack)
(set-default 'gb/extent-stack nil)

(defun gb/comint-process-escape (process escape)
  (let ((face (ignore-errors (car (read-from-string escape)))))
    (when face
      (cond ((eq face 'pop)
             (let ((ex (pop gb/extent-stack)))
               (when ex
                 (set-extent-property ex 'end-open t))))
            (t
             (let ((ex (make-extent (point) (point))))
               (push ex gb/extent-stack)
               (unless (listp face)
                 (setq face (list face)))
               (set-extent-property ex 'end-open nil)
               (set-extent-property ex 'face (car face))
               (do ((q (cdr face) (cddr q)))
                   ((null q))
                 (cond ((eq (car q) 'command)
                        (let ((km (make-keymap)))
                          (define-key km 'button2
                            ;; Grff backquote because we have no closures
                            `(lambda ()
                              (interactive "")
                              (end-of-buffer)
                              (insert-string ',(cadr q))
                              (fi:inferior-lisp-newline) ))
                          (set-extent-keymap ex km)) )
                       ((eq (car q) 'emacs-command)
                        (let ((km (make-keymap)))
                          (define-key km 'button2
                            ;; Grff backquote because we have no closures
                            `(lambda ()
                              (interactive "")
                              ,(cadr q) ))
                          (set-extent-keymap ex km)) )
                       (t
                        (set-extent-property ex (car q) (cadr q))))) ))))))

(defun comint-insert (output)
  "Insert process OUTPUT into the current buffer."
  (if output
      (let* ((buffer (current-buffer))
             (process (get-buffer-process buffer))
             (mark (process-mark process))
             (window (selected-window))
             (at-end nil))
        (if (eq (window-buffer window) buffer)
            (setq at-end (= (point) mark))
            (setq window (get-buffer-window buffer)))
        (save-excursion
          (goto-char mark)
          (dotimes (p (length output))
            (let ((c (elt output p)))
              (cond ((= c ?)
                     (setf gb/current-escape ""))
                    ((= c ?)
                     (gb/comint-process-escape process gb/current-escape)
                     (setf gb/current-escape nil))
                    (t
                     (if gb/current-escape
                         (setf gb/current-escape (concat gb/current-escape (string c)))
                         (insert c))))))
          (set-marker mark (point)))
        (if window 
            (progn
              (if (or at-end comint-always-scroll) (goto-char mark))
              (if (not (pos-visible-in-window-p (point) window))
                  (let ((original (selected-window)))
                    (save-excursion
                      (select-window window)
                      (recenter '(center))
                      (select-window original)))))))))

(defun gb/visit (file pos path)
  (find-file file)
  (goto-char pos)
  (when (not (null path))
    (dolist (k (reverse path))
      (down-list)
      (forward-sexp k)))
  (forward-sexp)
  (backward-sexp) )