ess 14.09-1 / usr / share / emacs / site-lisp / ess / ess-tracebug.el

;; ess-tracebug.el --- Tracing and debugging facilities for ESS.
;;
;; Copyright (C) 2011--2012 A.J. Rossini, Richard M. Heiberger, Martin Maechler,
;;      Kurt Hornik, Rodney Sparapani, Stephen Eglen and Vitalie Spinu.
;;
;; Filename: ess-tracebug.el
;; Author: Vitalie Spinu
;; Maintainer: Vitalie Spinu
;; Copyright (C) 2010-2012, Vitalie Spinu, all rights reserved.
;; Created: Oct 14 14:15:22 2010
;; URL: http://code.google.com/p/ess-tracebug/
;; Keywords: tools, languages
;;
;; This file is *NOT* part of GNU Emacs.
;;
;; This program 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 3, any later version.
;;
;; This program 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.
;;
;; A copy of the GNU General Public License is available at
;; http://www.r-project.org/Licenses/

;;
;; Features that might be required by this library:
;;
;;   ESS - required
;;   ido, face-remap, cl -  desirable and are part of default emacs
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Commentary:
;;  Ess-tracebug is a package for interactive debugging of R code from
;;  ESS and provides such features as:
;;  - visual debugging
;;  - browser, recover and conditional  breakpoints
;;  - watch window and loggers
;;  - on the fly  debug/undebug of R functions and methods
;;  - highlighting of error source references and easy error navigation
;;  - interactive traceback.
;;
;;  For a complete description please see the documentation at
;;  http://code.google.com/p/ess-tracebug/ and a brief tutorial at
;;  http://code.google.com/p/ess-tracebug/wiki/GettingStarted
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;; Code:

(require 'ess)
(require 'format-spec)
(eval-when-compile
  (require 'tramp)
  (require 'compile)
  (require 'overlay)
  (require 'cl))

(autoload 'ess-helpobjs-at-point        "ess-help" "[autoload]" nil) ;;todo: rename and put into a more neutral place
(defvar text-scale-mode-amount)
(autoload 'text-scale-mode              "face-remap" "[autoload]" nil)

(defgroup ess-tracebug nil
  "Error navigation and debugging for ESS.
Currently only R is supported."
  :link '(emacs-library-link :tag "Source Lisp File" "ess-tracebug.el")
  :group 'ess
  )

(defvar ess-tracebug-indicator " TB"
  "String to be displayed in mode-line alongside the process
  name. Indicates that ess-tracebug-mode is turned on. ")

;; (defvar ess--tracebug-p nil
;;   "Non nil if ess-tracebug is turned on for current process.
;; Function `ess-tracebug'  toggles on/off this variable.")
;; (make-variable-buffer-local 'ess--tracebug-p)
;; (add-to-list 'minor-mode-alist '(ess--tracebug-p ess-tracebug-indicator))


(defcustom ess-tracebug-prefix nil
  "*Key to be used as prefix for all ess-tracebug commands.

Set this to a key cominbation you don't use often, like:

 (setq ess-tracebug-prefix \"\\M-t\")

The postfix keys are defined in `ess-tracebug-map':
\\{ess-tracebug-map}
"
  :type 'string
  :group 'ess-tracebug)

;; (make-obsolete-variable 'ess-tracebug-prefix "ess-tracebug-prefix will be removed in future versions.
;; Electric debug keys are now on C-c and ess-dev maps." "ESS 13.05")
;; (define-obsolete-variable-alias 'ess-tracebug-command-prefix 'ess-tracebug-prefix)


(defcustom ess-inject-source 'function-and-buffer
  "Control the source injection into evaluated code.

If t,  always inject source reference.
If function,  inject only for functions,
If function-and-buffer, inject for functions and whole buffer (the default),
If nil, never inject.

When tracebug is active (the default), ESS instructs the
subprocess to keep the source code references.

If this variable is t, you won't be able to execute blocks which
don't form a valid R expression. That is, if your expression
spreads multiple paragraphs, and you call C-c C-c on first
paragraph, R will report an error."
  :group 'ess-tracebug
  :type '(choice (const nil) (const function) (const function-and-buffer) (const t)))

(define-obsolete-variable-alias 'ess-tracebug-inject-source-p 'ess-inject-source "ESS v13.09")

(defcustom ess-tracebug-enter-hook nil
  "List of functions to call on entry to ess-tracebug mode.
Use `add-hook' to insert append your functions to this list.
"
  :group 'ess-tracebug
  :type 'hook)

(defcustom ess-tracebug-exit-hook nil
  "List of functions to call on exit of ess-tracebug mode.
Use `add-hook' to insert append your functions to this list.
"
  :group 'ess-tracebug
  :type 'hook)

(autoload 'ess-dev-map "ess-r-d" "[autoload]" nil)
(defvaralias 'ess-tracebug-map 'ess-dev-map)

(defvar ess--tracebug-eval-index 0
  "This is used by to track source references in evaluation with source.
For example, each time ess-eval-function is called the evaluated
region is marked.  When debugger enteres the code it desplayes
this reference number. Ess-debug finds this number in the
referenced buffer.")

;; these vars are org variables that store the src block locations
(defvar org-edit-src-beg-marker nil)
(defvar org-babel-current-src-block-location nil
  "Marker pointing to the src block currently being executed.
This may also point to a call line or an inline code block.  If
multiple blocks are being executed (e.g., in chained execution
through use of the :var header argument) this marker points to
the outer-most code block.")

;; hash to store soruce references of the form: tmpname -> (filename . src_start)
(defvar ess--srcrefs (make-hash-table :test 'equal :size 100))

(defvar ess-tracebug-original-buffer-marker nil
  "Marker pointing to the beginning of original source code.

If non-nil, tracebug will insert the source references based on
this location instead of the current buffer. This is useful for
applications, like org-babel,  that call ess evaluation functions
from temporary buffers.")


(defun ess--make-source-refd-command (beg end &optional visibly)
  "Transform region string in order to add source references.
Return new command, a string."
  (let* ((filename buffer-file-name)
         (proc-dir (ess-get-process-variable 'default-directory))
         (remote (when (file-remote-p proc-dir)
                   (require 'tramp)
                   ;; should this be done in process buffer?
                   (tramp-dissect-file-name proc-dir)))
         (orig-marker (or ess-tracebug-original-buffer-marker
                          org-edit-src-beg-marker
                          org-babel-current-src-block-location))
         orig-beg)
    (setq ess--tracebug-eval-index (1+ ess--tracebug-eval-index))
    (goto-char beg)
    (skip-chars-forward " \t\n")
    (setq beg (point))
    (goto-char end)
    (skip-chars-backward " \t\n")
    (setq end (point)
          orig-beg beg)

    ;; delete all old temp files
    (when (and (not (ess-process-get 'busy))
               (< 1 (float-time
                     (time-subtract (current-time)
                                    (ess-process-get 'last-eval)))))
      (dolist (f (ess-process-get 'temp-source-files))
        (and (file-exists-p f)
             (delete-file f)))
      (ess-process-put 'temp-source-files nil))

    (when (markerp orig-marker)
      (setq filename (buffer-file-name (marker-buffer orig-marker)))
      (setq orig-beg (+ beg (marker-position orig-marker))))

     (let ((tmpfile
            (expand-file-name (make-temp-name
                               (concat (file-name-nondirectory
                                        (or filename "unknown")) "!"))
                              (if remote
                                  (tramp-get-remote-tmpdir remote)
                                temporary-file-directory)))
           (eval-format  (if visibly
                             ess-eval-visibly-command
                           (or ess-eval-visibly-noecho-command
                               ess-eval-command))))

       (ess-process-put 'temp-source-files
                        (cons tmpfile (ess-process-get 'temp-source-files)))

       (when remote
         ;; get local name (should this be done in process buffer?)
         (setq tmpfile (with-parsed-tramp-file-name tmpfile nil localname)))

       (if (not filename)
           (puthash tmpfile (list nil ess--tracebug-eval-index nil) ess--srcrefs)
         (puthash tmpfile (list filename ess--tracebug-eval-index orig-beg) ess--srcrefs)
         (puthash (file-name-nondirectory tmpfile) ; R sometimes strips dirs
                  (list filename ess--tracebug-eval-index orig-beg) ess--srcrefs)
         (with-silent-modifications
           (put-text-property beg end 'tb-index ess--tracebug-eval-index)))

       ;; sending string to subprocess is considerably faster than tramp file
       ;; transfer. So, give priority to ess-eval-*-command if available
       (if eval-format
           (format-spec eval-format
                        `((?s . ,(ess-quote-special-chars
                                  (buffer-substring-no-properties beg end)))
                          (?f . ,tmpfile)))
         ;; else: use ess-load-*-command
         (write-region beg end tmpfile nil 'silent)
         (if (and visibly ess-load-visibly-command)
             (format ess-load-visibly-command tmpfile)
           (format (or ess-load-visibly-noecho-command
                       ess-load-command)
                   tmpfile))))))


(defun ess-tracebug-send-region (proc start end &optional visibly message type)
  "Send region to process adding source references as specified
by `ess-inject-source' variable."
  (let* ((inject-p  (cond ((eq type 'function)
                           ess-inject-source)
                          ((eq type 'buffer)
                           (or (eq ess-inject-source t)
                               (eq ess-inject-source 'function-and-buffer)))
                          (t (eq ess-inject-source t))))
         (ess--debug-del-empty-p (if inject-p nil ess--dbg-del-empty-p))
         ;; don't call ess-eval-linewise when subprocess does the job
         (vis (unless (and inject-p ess-load-visibly-command)
                (if (eq visibly 'no-wait)
                    (buffer-substring start end)
                  visibly)))
         (string (if inject-p
                     (ess--make-source-refd-command start end visibly)
                   (buffer-substring start end))))
    (ess-send-string proc string vis message)))

(defun ess-tracebug-send-function (proc start end &optional visibly message)
  "Like `ess-tracebug-send-region' but with tweaks for functions."
  (ess-tracebug-send-region proc start end visibly message 'function))

(defvar ess-tracebug-help nil
  "
ess-dev-map prefix: \\[ess-dev-map]

* Breakpoints (`ess-dev-map'):

 b   . Set BP (repeat to cycle BP type) . `ess-bp-set'
 B   . Set conditional BP               . `ess-bp-set-conditional'
 k   . Kill BP                          . `ess-bp-kil'
 K   . Kill all BPs                     . `ess-bp-kill-all'
 o   . Toggle BP state                  . `ess-bp-toggle-state'
 l   . Set logger BP                    . `ess-bp-set-logger'
 n   . Goto next BP                     . `ess-bp-next'
 p   . Goto previous BP                 . `ess-bp-previous'

  (C- prefixed equivalents are also defined)

* Debugging (`ess-dev-map'):
 `   . Show traceback                       . `ess-show-traceback' (also on C-c `)
 ~   . Show callstack                       . `ess-show-call-stack' (also on C-c ~)
 e   . Toggle error action (repeat to cycle). `ess-debug-toggle-error-action'
 d   . Flag for debugging                   . `ess-debug-flag-for-debugging'
 u   . Unflag for debugging                 . `ess-debug-unflag-for-debugging'
 w   . Watch window                         . `ess-watch'

  (C- prefixed equivalents are also defined)

* Interactive Debugging (`ess-debug-minor-mode-map'):

 M-C   . Continue                  . `ess-debug-command-continue'
 M-C-C . Continue multi            . `ess-debug-command-continue-multi'
 M-N   . Next step                 . `ess-debug-command-next'
 M-C-N . Next step multi           . `ess-debug-command-next-multi'
 M-U   . Up frame                  . `ess-debug-command-up'
 M-Q   . Quit debugging            . `ess-debug-command-quit'

* Navigation to errors (general emacs functionality):

 C-x `, M-g n   . `next-error'
 M-g p          . `previous-error'

")


;; * Input Ring:

;; i   . Goto input event marker forwards     . `ess-debug-goto-input-event-marker'
;; I   . Goto input event marker backwards    . `ess-debug-goto-input-event-marker'


(defun ess-tracebug-show-help (&optional ev)
  (interactive)
  (describe-variable 'ess-tracebug-help))

(defun ess-tracebug--propertize (dummy bitmap face &optional string )
  "If window-system propertize DUMMY with fringe BITMAP and FACE,
else propertize  line-prefix and margin  with STRING and  FACE"
  (unless string
    (setq string dummy))
  (if window-system
      (propertize dummy 'display (list 'left-fringe bitmap face))
    (propertize dummy
                'display (list '(margin left-margin)
                               (propertize string
                                           'font-lock-face face
                                           'face face)))))


(defun ess-tracebug (&optional arg)
  "Toggle ess-tracebug mode.
With ARG, turn ess-tracebug mode on if and only if ARG is
positive.

This mode adds to ESS the interactive debugging, breakpoint and
error navigation functionality.  Strictly speaking ess-tracebug
is not a minor mode. It integrates globally into ESS and iESS.

Note: Currently, ess-tracebug does not detect some of R's debug
related messages in non-English locales. To set your R messages
to English add the following line to your .Rprofile init file:

   Sys.setlocale(\"LC_MESSAGES\", \"C\")


See `ess-tracebug-help' for the overview of ess-tracebug functionality."

  ;; Note: The functionality in ess-tracebug is divided on conceptual
  ;; grounds in tracing and debugging and could be
  ;; activated/deactivate separately with `ess--tb-start' and
  ;; `ess-debug-start' respectively.

  (interactive "P")
  (ess-force-buffer-current "R process to activate tracebug in: ")
  (with-current-buffer (process-buffer (get-process ess-local-process-name))
    (when (equal ess-dialect "R")
      (setq arg
            (if arg
                (prefix-numeric-value arg)
              (if (ess-process-get 'tracebug) -1 1)))
      (if (> arg 0)
          (unless (ess-process-get 'tracebug) ;; only if already not active
            (ess--tb-start)
            (ess-debug-start)
            ;; (dolist (bf (buffer-list))
            ;;   (with-current-buffer bf
            ;;     (when (and (eq major-mode 'ess-mode)
            ;;                (equal ess-dialect "R"))
            ;;       (ess-bp-recreate-all))))
            ;; watch functionality
            (if ess-tracebug-prefix
                (let ((comm (key-binding ess-tracebug-prefix)))
                  ;; (message "ess-tracebug-prefix will be removed in future versions. Electric debug keys are now on [C-c] and [C-c C-t] maps.")
                  ;; (sit-for 1)
                  (when (commandp comm)
                    (define-key ess-tracebug-map ess-tracebug-prefix comm))
                  (define-key ess-mode-map ess-tracebug-prefix ess-tracebug-map)
                  (define-key inferior-ess-mode-map ess-tracebug-prefix ess-tracebug-map)
                  (define-key ess-watch-mode-map ess-tracebug-prefix ess-tracebug-map)))
            (run-hooks 'ess-tracebug-enter-hook)
            (ess-process-put 'tracebug t)
            (message "ess-tracebug mode enabled"))
        (when (ess-process-get 'tracebug) ;;only when active
          (ess-process-put  'tracebug nil)
          ;; unset the map
          (when ess-tracebug-prefix
            (define-key ess-mode-map ess-tracebug-prefix nil)
            (define-key inferior-ess-mode-map ess-tracebug-prefix nil))
          (ess--tb-stop)
          (ess-debug-stop)
          (run-hooks 'ess-tracebug-exit-hook)
          (message "ess-tracebug mode disabled"))))))

(defalias 'ess-toggle-tracebug 'ess-tracebug)


;;;_* TRACEBACK

;; (defface ess--tb-last-input-face
;;   '((((class grayscale)
;;       (background light)) (:background "DimGray"))
;;     (((class grayscale)
;;       (background dark))  (:background "LightGray"))
;;     (((class color) (background light) (min-colors 88))
;;      (:overline "medium blue" ))
;;     (((class color) (background dark) (min-colors 88))
;;      (:overline "deep sky blue" ))
;;     (((background light))  (:weight bold))
;;     (((background dark)) (:weight bold))
;;     )
;;   "Face to highlight currently debugged line."
;;   :group 'ess-tracebug )

(defface ess-tracebug-last-input-fringe-face
  '((((background light) (min-colors 88)) (:foreground "medium blue" :overline "medium blue"))
    (((background dark) (min-colors 88))  (:foreground "deep sky blue" :overline "deep sky blue"))
    (((background light) (min-colors 8))  (:foreground "blue"))
    (((background dark) (min-colors 8))  (:foreground "syan")))
  "Face for fringe bitmap for last-input position."
  :group 'ess-tracebug)

(if (fboundp 'define-fringe-bitmap)
    (define-fringe-bitmap 'last-input-arrow
      [#b00011111
       #b00010000
       #b00010000
       #b00010000
       #b00010000
       #b00010000
       #b00010000
       #b00010000
       #b00010000
       #b00010000
       #b11010111
       #b01111100
       #b00111000
       #b00010000] nil nil 'top))


(defvar ess--tb-last-input (make-marker)
  "Marker pointing to the last user input position in iESS buffer.
This is the place where `ess--tb-last-input-overlay' is moved.
Local in iESS buffers with `ess-tracebug' mode enabled.")

(defvar ess--tb-last-input-overlay nil
  "Overlay to highlight the position of last input in iESS buffer.
Local in iESS buffers.")

(defvar ess--busy-count 0
  "Used to compute the busy indicator")
(make-variable-buffer-local 'ess--busy-count)

;; (unless (boundp 'ess--busy-slash)
;; (defvar ess--busy-slash '(32 ?\u2014 92 47))
;; (setq ess--busy-slash (mapcar (lambda (el) (format " %c " el))
;;                               ess--busy-slash))
;; )


(defvar ess--busy-slash '("   " " - " " \\ " " / "))
(defvar ess--busy-B '("   " " B " "   "))
(defvar ess--busy-stars '("      " "      " " *    " " **   " " ***  " " **** "))
(defvar ess--busy-vbars '("      " "      " " |    " " ||   " " |||  " " |||| "))

(defcustom ess-busy-strings ess--busy-slash
  "List of strings to replace in turn for busy indication.
The first element of the list is used as an indicator of the
process being ready (i.e. not busy). Implemented lists that you
can use `ess--busy-slash', `ess--busy-B',`ess--busy-stars',
`ess--busy-vbars'"
  :group 'ess)

(defvar ess--busy-timer nil
  "Timer used for busy process indication")

(defcustom inferior-ess-split-long-prompt t
  "If non-nil, long prompt '> > > > > + + + + > ' is split."
  :group 'ess-tracebug)

(defcustom inferior-ess-replace-long+ t
  "If non-nil,  '+ + + + ' containing more than 4 + is replaced by `ess-long+replacement'"
  :group 'ess-tracebug)

(defvar ess-long+replacement "+ . + "
  "Replacement used for long + prompt.
Customization of this variable is not recommended. You can set it
to '. '. If you set it to anything else you will have to change
`inferior-S-prompt' to assure the correct prompt navigation
in inferior buffers.  ")

(defmacro ess-copy-key (from-map to-map fun)
  `(define-key ,to-map
     (car (where-is-internal ,fun  ,from-map))
     ,fun))

;;;_ + traceback functions
(defun ess--tb-make-last-input-overlay (beg end)
  "Create an overlay to indicate the last input position."
  (let   ((ove (make-overlay beg end)))
    (overlay-put ove 'before-string
                 (ess-tracebug--propertize "!"  'last-input-arrow 'ess-tracebug-last-input-fringe-face))
    ;; (overlay-put ove 'face  'ess--tb-last-input-face)
    (overlay-put ove 'evaporate t)
    ove))


(defun ess--tb-start ()
  "Start traceback session "
  (with-current-buffer (process-buffer (get-process ess-local-process-name))
    (unless ess-error-regexp-alist
      (error "Can not activate the traceback for %s dialect" ess-dialect))
    (set (make-local-variable 'compilation-error-regexp-alist)
         ess-error-regexp-alist)
    (let (compilation-mode-font-lock-keywords)
     (compilation-setup t))
    (setq next-error-function 'ess-tracebug-next-error-function)
    ;; new locals
    (make-local-variable 'ess--tb-last-input)
    (make-local-variable 'ess--tb-last-input-overlay)
    (make-local-variable 'compilation-search-path)
    (setq compilation-search-path ess-tracebug-search-path) ;; todo: make this dialect specific
    (ess-tracebug--set-left-margin)
    (save-excursion
      (goto-char comint-last-input-start)
      (setq ess--tb-last-input (point))
      (setq ess--tb-last-input-overlay
            (ess--tb-make-last-input-overlay
             (point-at-bol) (point-at-eol))))
    ;; busy timer
    (setq mode-line-buffer-identification
          (list (car (propertized-buffer-identification "%3b"))
                `(:eval  (nth ess--busy-count ess-busy-strings)))) ;; 'face 'mode-line-buffer-id))))
    (make-local-variable 'ess--busy-timer)
    (setq ess--busy-timer
          (run-with-timer 2 .5 (ess--make-busy-timer-function (get-buffer-process (current-buffer)))))
    (add-hook 'kill-buffer-hook (lambda () (cancel-timer ess--busy-timer)))
    (add-hook 'comint-input-filter-functions  'ess-tracebug-set-last-input nil 'local)

    ;; redefine
    ;; todo: all this part should go
    (when (equal ess-dialect "R")
      (process-put (get-buffer-process (current-buffer))
                   'source-file-function
                   'ess--tb-R-source-current-file))
    (unless (fboundp 'orig-ess-parse-errors)
      (defalias 'orig-ess-parse-errors (symbol-function 'ess-parse-errors))
      (defalias 'ess-parse-errors (symbol-function 'next-error)))))

(defun ess--tb-stop ()
  "Stop ess traceback session in the current ess process"
  (with-current-buffer (process-buffer (get-process ess-current-process-name))
    ;; restore original definitions
    (when (equal ess-dialect "R")
      (when (fboundp 'orig-ess-parse-errors)
        (defalias 'ess-parse-errors (symbol-function 'orig-ess-parse-errors))
        (fmakunbound 'orig-ess-parse-errors)))
    (if (local-variable-p 'ess--tb-last-input-overlay)
        (delete-overlay ess--tb-last-input-overlay))
    (kill-local-variable 'ess--tb-last-input-overlay)
    (kill-local-variable 'ess--tb-last-input)
    (font-lock-remove-keywords nil (compilation-mode-font-lock-keywords))
    (font-lock-fontify-buffer)
    (kill-local-variable 'compilation-error-regexp-alist)
    (kill-local-variable 'compilation-search-path)
    (cancel-timer ess--busy-timer)
    (remove-hook 'comint-input-filter-functions  'ess-tracebug-set-last-input 'local)
    (setq mode-line-buffer-identification (propertized-buffer-identification "%12b"))))

(defvar ess--dbg-forward-ring (make-ring 10)
  "Ring of markers to the positions of the user inputs
 when the  debugger or traceback events are initiated.  It is used in
 `ess--dbg-goto-input-point'.")

(defvar ess--dbg-backward-ring (make-ring 10)
  "Ring of markers to the positions from which `ess--dbg-goto-input-point' is called.
 See the also `ess--dbg-goto-debug-point'")


;; (setq ess-R--tb-regexp-alist '(R R2 R3 R-recover))
;;(pop compilation-error-regexp-alist-alist)

(defun ess-show-traceback ()
  "Display R traceback and last error message.
Pop up a compilation/grep/occur like buffer. Usual global key
bindings are available \(\\[next-error] and \\[previous-error]\)
for `next-error' and `previous-error' respectively.

You can bind 'no-select' versions of this commands:
\(define-key compilation-minor-mode-map [(?n)] 'next-error-no-select\)
\(define-key compilation-minor-mode-map [(?p)] 'previous-error-no-select\)
"
  (interactive)
  (if (null ess-traceback-command)
      (error "Not implemented for dialect %s" ess-dialect)
    (ring-insert ess--dbg-forward-ring (point-marker))
    (ess-force-buffer-current "R process to use: ")
    (let ((trbuf  (get-buffer-create "*ess-traceback*"))
          (lproc-name ess-local-process-name)
          (alist ess-mode-editing-alist)
          (cmd ess-traceback-command))
      (setq next-error-last-buffer trbuf)
      (with-current-buffer trbuf
        (setq buffer-read-only nil)
        (setq ess-local-process-name lproc-name)
        (ess-command cmd trbuf)
        (goto-char (point-min))
        ;; fixme: this is R specific check
        (if (re-search-forward "No traceback available" nil t)
            (message "No traceback available")
          (ess-dirs)
          (message nil)
          (make-local-variable 'compilation-error-regexp-alist)
          (setq compilation-error-regexp-alist ess-R-error-regexp-alist)
          (make-local-variable 'compilation-search-path)
          (setq compilation-search-path ess-tracebug-search-path)
          (ess-setq-vars-local alist)
          (font-lock-refresh-defaults)
          (compilation-minor-mode 1)
          (setq next-error-function 'ess-tracebug-next-error-function)
                                        ;(use-local-map ess-traceback-minor-mode-map)
          ;; ess keys
          (local-set-key "\C-c\C-s" 'ess-watch-switch-process)
          (local-set-key "\C-c\C-y" 'ess-switch-to-ESS)
          (local-set-key "\C-c\C-z" 'ess-switch-to-end-of-ESS)

          (setq buffer-read-only t)
          (pop-to-buffer trbuf))))))

(defvar ess-call-stack-command nil)
(defun ess-show-call-stack ()
  "Display current call stack.
Also see `ess-show-traceback'"
  (interactive)
  (let ((ess-traceback-command ess-call-stack-command))
    (ess-show-traceback)))

(defalias 'ess-show-R-traceback 'ess-show-traceback)

(defun ess--tb-next-error-goto-process-marker ()
  ;; assumes current buffer is the process buffer with compilation enabled
  ;; used in ess-tracebug-next-error-function
                                        ;  (with-current-buffer (process-buffer (get-process ess-local-process-name)) ; already in comint buffer .. no need
  (comint-goto-process-mark)
  (set-window-point (get-buffer-window) (point))  ;moves the cursor
  ;; FIXME: Should jump to current-debug-position,  but messes the things if in recover
  ;; (when (ess-debug-is-active)
  ;;   (ess-debug-goto-current-debug-position)
  ;;   )
  )

(defun ess-tracebug-next-error-function (n &optional reset)
  "Advance to the next error message and visits the file.
This is the value of `next-error-function' in iESS buffers."
  ;; Modified version of `compilation-next-error-function'.
  (interactive "p")
  (if reset  (goto-char (point-max)))
  (let* ((columns compilation-error-screen-columns) ; buffer's local value
         ;; (proc (or (get-buffer-process (current-buffer))
         ;;                         (error "Current buffer has no process")))
         (pbuff-p (get-buffer-process (current-buffer)))
         (last 1)
         (n (or n 1))
         timestamp
         (beg-pos  ; from where the search for next error starts
          (if (and pbuff-p
                   (>= n 0)
                   (comint-after-pmark-p))
              ess--tb-last-input
            (point)))
         (at-error t)
         (msg
          (condition-case err
              (compilation-next-error n  nil beg-pos)
            (error
             (when pbuff-p
               (ess--tb-next-error-goto-process-marker))
             (if (< n 0)
                 (message "Before first reference")
               (message "Beyond last reference"));(error-message-string err))
             (setq at-error nil))))
         (msg (if (or (not pbuff-p)
                      (eq n 0)
                      (> (point) ess--tb-last-input))
                  msg
                (ess--tb-next-error-goto-process-marker)
                (message "Beyond last-input marker")
                (setq at-error nil)))
         (marker (point-marker))
         loc end-loc)
    (when at-error
      (setq compilation-current-error (point-marker)
            overlay-arrow-position (if (bolp)
                                       compilation-current-error
                                     (copy-marker (line-beginning-position)))
            loc (if (fboundp 'compilation--message->loc)
                    (compilation--message->loc msg)
                  (car msg))
            end-loc (if (fboundp  'compilation--message->end-loc) ;; emacs 24
                        (compilation--message->end-loc msg)
                      (nth 2 msg)))
      (let* ((file (caar (nth 2 loc)))
             (col (car loc))
             (line (cadr loc))
             (mkrs (ess--dbg-create-ref-marker file line col)))
        (if mkrs
            ;; is this really needed? Shall we go directly to the location?
            (compilation-goto-locus marker (car mkrs) (cadr mkrs))
          (message "Reference to '%s' not found" file))))))


(defun inferior-ess-move-last-input-overlay ()
  "Move the overlay to the point."
  (let ((pbol (point-at-bol)))
    (move-overlay ess--tb-last-input-overlay
                  pbol (max (- (point) 2) (+ pbol 2)))))


;;;_* DEBUGGER
(defgroup ess-debug nil
  "Debugging for ESS"
  :link '(emacs-library-link :tag "Source Lisp File" "ess-tracebug.el")
  :group 'ess-tracebug
  :prefix "ess-debug-")

(defcustom  ess-debug-error-action-alist
  '(( "-" "NONE"       "NULL" )
    ( "r" "RECOVER"    "utils::recover")
    ( "t" "TRACEBACK"  "base::traceback"))
  "Alist of 'on-error' actions.
Toggled with `ess-debug-toggle-error-action'.  Each element must
have the form (DISP SYMB ACTION) where DISP is the string to be
displayed in the mode line when the action is in place. SYMB is
the symbolic name of an action. ACTION is the string giving the
actual expression to be assigned to 'error' user option. See R's
help ?options for more details.
"
  :type '(alist :key-type string
                :value-type (string string))
  :group 'ess-debug)

(defvar ess--dbg-output-buf-prefix " *ess.dbg"
  "The prefix of the buffer name the R debug output is directed to."  )

(defvar ess--dbg-current-ref (make-marker)
  "Current debug reference in *ess.dbg* buffers (a marker).")
(make-variable-buffer-local 'ess--dbg-current-ref)

(defvar ess--dbg-last-ref-marker (make-marker)
  "Last debug reference in *ess.dbg* buffer (a marker).")
(make-variable-buffer-local 'ess--dbg-last-ref-marker)

(defcustom ess-tracebug-search-path nil
  "List of directories to search for source files.
Elements should be directory names, not file names of directories.
"
  :type '(choice (const :tag "Unset" nil)
                 (repeat :tag "Directory list" (string :tag "Directory")))
  :group 'ess-debug)
(defalias 'ess--dbg-search-path 'ess-tracebug-search-path)
(make-obsolete 'ess--dbg-search-path 'ess-tracebug-search-path "ESS[12.09]")

(defvar ess--dbg-buf-p nil
  "This is t in ess.dbg buffers.")
(make-variable-buffer-local 'ess--dbg-buf-p)

;; (defcustom ess--dbg-auto-single-key-p t
;;   "If t entering the debug state triggers single-key mode.
;; Set it to nil if you want to trigger single-key mode manually
;; with the `ess-tracebug-prefix' key.
;; ")

(defvar ess--dbg-current-debug-position (make-marker)
  "Marker to the current debugged line.
 It always point to the beginning of the currently debugged line
and is used by overlay-arrow.
In no-windowed emacs an `overlay-arrow' is displayed at this position.")

(unless  window-system
  (add-to-list 'overlay-arrow-variable-list 'ess--dbg-current-debug-position))

(defface ess-debug-current-debug-line-face
  '((((class grayscale)
      (background light)) (:background "DimGray"))
    (((class grayscale)
      (background dark))  (:background "LightGray"))
    (((class color)
      (background light) (min-colors 88)) (:background "tan"))
    (((class color)
      (background dark) (min-colors 88))  (:background "gray20"))
    (((background light) (min-colors 8))  (:weight bold))
    (((background dark) (min-colors 8))  (:weight bold)))
  "Face used to highlight currently debugged line."
  :group 'ess-debug)


(defvar  ess--dbg-current-debug-overlay
  (let ((overlay (make-overlay (point) (point))))
    (overlay-put overlay 'face  'ess-debug-current-debug-line-face)
    (overlay-put overlay 'evaporate t)
    overlay)
  ;; should be global variable!!
  "The overlay for currently debugged line.")


(defcustom ess-debug-blink-interval .2
  "Time in seconds to blink the background
 of the current debug line on exceptional events.
 Currently two exceptional events are defined 'ref-not-found'
 and 'same-ref'. Blinking colors for these events can be
 customized by corresponding faces."
  :group 'ess-debug
  :type 'float)

(defface ess-debug-blink-ref-not-found-face
  '((((class grayscale) (background light)) (:background "DimGray"))
    (((class grayscale) (background dark))  (:background "LightGray"))
    (((class color) (background light) (min-colors 88)) (:background "IndianRed4"))
    (((class color) (background dark) (min-colors 88))  (:background "dark red"))
    (((background light) (min-colors 8))  (:foreground "red"))
    (((background dark) (min-colors 8))  (:foreground "red")))
  "Face used to blink currently debugged line's background
 when the reference file is not found. See also `ess-debug-ask-for-file'"
  :group 'ess-debug )

(defface ess-debug-blink-same-ref-face
  '((((class grayscale) (background light)) (:background "DimGray"))
    (((class grayscale) (background dark))  (:background "LightGray"))
    (((class color) (background light) (min-colors 88)) (:background "steel blue"))
    (((class color) (background dark) (min-colors 88))  (:background "midnight blue"))
    (((background light) (min-colors 8))  (:foreground "blue"))
    (((background dark) (min-colors 8))  (:foreground "cyan")))
  "Face used to highlight currently debugged line when new debug
reference is the same as the preceding one. It is highlighted for
`ess-debug-blink-interval' seconds."
  :group 'ess-debug )



(defcustom ess-debug-indicator " db "
  "String to be displayed in mode-line alongside the process
  name. Indicates that ess-debug-mode is turned on. When the
  debugger is in active state this string is shown in upper case
  and highlighted."
  :group 'ess-debug
  :type 'string)


(defcustom ess-debug-ask-for-file nil
  "If non nil, ask for file if the current debug reference is not found.

If nil, the currently debugged line is highlighted for
`ess-debug-blink-interval' seconds."
  :group 'ess-debug
  :type 'boolean)

(defcustom ess-debug-skip-first-call t
  "If non-nil, skip first debugger call.

In R first call doesn't contain source references and is skipped
by default."
  :group 'ess-debug
  :type 'boolean)

(defvar ess-electric-selection-map
  (let (ess-electric-selection-map)
    (define-prefix-command 'ess-electric-selection-map)
    ;; command-c and command-Q are not always working reliably
    (define-key ess-electric-selection-map "\M-N" 'ess-debug-command-continue)
    (define-key ess-electric-selection-map "\M-C" 'ess-debug-command-continue)
    (define-key ess-electric-selection-map "\M-Q" 'ess-debug-command-quit)
    (define-key ess-electric-selection-map "0" 'ess-debug-command-digit)
    (define-key ess-electric-selection-map "1" 'ess-debug-command-digit)
    (define-key ess-electric-selection-map "2" 'ess-debug-command-digit)
    (define-key ess-electric-selection-map "3" 'ess-debug-command-digit)
    (define-key ess-electric-selection-map "4" 'ess-debug-command-digit)
    (define-key ess-electric-selection-map "5" 'ess-debug-command-digit)
    (define-key ess-electric-selection-map "6" 'ess-debug-command-digit)
    (define-key ess-electric-selection-map "7" 'ess-debug-command-digit)
    (define-key ess-electric-selection-map "8" 'ess-debug-command-digit)
    (define-key ess-electric-selection-map "9" 'ess-debug-command-digit)
    (define-key ess-electric-selection-map "?" 'ess-tracebug-show-help)
    ess-electric-selection-map)
  "Keymap used to define commands for single key input mode.
This commands are triggered by `ess-electric-selection' .

\\{ess-electric-selection-map}
")

(ess-if-verbose-write "\n<- debug-vars done")

;;;_ + debug functions
(defun ess-debug-set-error-action (spec)
  "Set the on-error action. The ACTION should be  one
of components of `ess-debug-error-action-alist' (a cons!)."
  (let ((proc (get-process ess-local-process-name)))
    (if spec
        (with-current-buffer (process-buffer proc)
          (process-put proc 'on-error-action (car spec))
          (ess-command (format "options(error= %s )\n" (nth 2 spec))))
      (error "Unknown action."))))

(defun ess-debug-toggle-error-action ()
  "Toggle the 'on-error' action.
The action list is in `ess-debug-error-action-alist'. "
  (interactive)
  (ess-force-buffer-current)
  (let* ((alist ess-debug-error-action-alist)
         (ev last-command-event)
         (com-char  (event-basic-type ev))
         (cur-action (or (ess-process-get 'on-error-action)
                         "-"))
         actions act)
    (setq actions
          (cdr (member (assoc cur-action ess-debug-error-action-alist)
                       ess-debug-error-action-alist)))
    (unless actions
      (setq actions ess-debug-error-action-alist))
    (setq act (pop actions))
    (ess-debug-set-error-action act)
    (message "On-error action set to: %s"
             (propertize (cadr act) 'face 'font-lock-function-name-face))
    (while  (eq (event-basic-type (setq ev (read-event))) com-char)
      (unless actions
        (setq actions ess-debug-error-action-alist))
      (setq act (pop actions))
      (ess-debug-set-error-action act)
      (message "On-error action set to: %s"
               (propertize (cadr act) 'face 'font-lock-function-name-face)))
    (push ev unread-command-events)))

(defun ess--dbg-activate-overlays ()
  "Initialize active debug line overlays."
  (move-overlay ess--dbg-current-debug-overlay
                (point-at-bol) (1+ (point-at-eol)) (current-buffer))
  ;; used by overlay-arrow functionality on no-X,  should be bol
  (move-marker ess--dbg-current-debug-position (point-at-bol)))

(defun ess--dbg-deactivate-overlays ()
  "Deletes markers and overlays. Overlay arrow remains to indicate the last debug position."
  (delete-overlay ess--dbg-current-debug-overlay)
  (set-marker ess--dbg-current-debug-position nil))


;;;_ + Work Flow
(defun ess-debug-goto-input-event-marker ()
  "Jump to the point where the last debugger/traceback etc event occurred.

   Mainly useful during/after debugging, to jump to the place
from where the code was initialy executed.  This is an
electric-command, which means that after the command is triggered a
single key event is enough to navigate through the input-event-S-ring.
If the key-event which triggered the command is Shift modified
the input-event-S-ring is traversed backwards.

The input-event-S-ring is a virtual object which consists of two
rings `ess--dbg-forward-ring' and `ess--dbg-backward-ring' which
are joint at their tops.

See the more info at http://code.google.com/p/ess-tracebug/#Work-Flow
"
  (interactive)
  (let* ((ev last-command-event)
         (com-char  (event-basic-type ev))
         (ring-el 0)
         input-point)
    (if (memq 'shift (event-modifiers ev))
        (setq input-point (ring-ref ess--dbg-backward-ring 0))
      (ring-insert ess--dbg-backward-ring (point-marker)) ;; insert in backward ring ;;todo: check if the marker to this (close by?) position is already in the ring
      (setq input-point (ring-ref ess--dbg-forward-ring 0)))
    (when (marker-buffer input-point) ;; todo: give a message here if buff is not found
      (switch-to-buffer (marker-buffer input-point))
      (when (marker-position input-point)
        (goto-char (marker-position input-point))))
    (while  (eq (event-basic-type  (event-basic-type (setq ev (read-event)))) com-char)
      (if (memq 'shift (event-modifiers ev))
          (setq ring-el (1- ring-el))
        (setq ring-el (1+ ring-el)))
      (if (< ring-el 0)
          (setq input-point (ring-ref ess--dbg-backward-ring (- ring-el)))  ;; get it from backward-ring
        ;; get it from forward-ring
        (setq input-point (ring-ref ess--dbg-forward-ring ring-el)) )
      (when (marker-buffer input-point)
        (switch-to-buffer (marker-buffer input-point))
        (when (marker-position input-point)
          (goto-char (marker-position input-point)))))
    (push ev unread-command-events)))

(defun ess-debug-goto-debug-point ()
  "Returns to the debugging position.
Jump to markers stored in `ess--dbg-backward-ring'. If debug
session is active, first jump to current debug line.

This is an electric-command. Shift triggers the opposite traverse
of the ring."
  (interactive)
  (let* ((debug-point (ring-ref ess--dbg-backward-ring 0))
         (ev last-command-event)
         (com-char  (event-basic-type ev))
         (ring-el 0))
    (if (ess--dbg-is-active-p)
        (progn
          (switch-to-buffer (marker-buffer ess--dbg-current-debug-position))
          (goto-char (marker-position ess--dbg-current-debug-position ))
          (back-to-indentation))
      (switch-to-buffer (marker-buffer debug-point))
      (goto-char (marker-position debug-point)))
    (while  (eq (event-basic-type (setq ev (read-event))) com-char)
      (if (memq 'shift (event-modifiers ev))
          (setq ring-el (1- ring-el))
        (setq ring-el (1+ ring-el)))
      (setq debug-point (ring-ref ess--dbg-backward-ring ring-el))
      (when (marker-buffer debug-point)
        (switch-to-buffer (marker-buffer debug-point))
        (when (marker-position debug-point)
          (goto-char (marker-position debug-point)))))
    (push ev unread-command-events)))

(defun ess-debug-insert-in-forward-ring ()
  (interactive)
  "Inserts point-marker into the forward-ring."
  (ring-insert ess--dbg-forward-ring (point-marker))
  (message "Point inserted into the forward-ring"))

(defvar ess--dbg-mode-line-indicator
  '(:eval (let ((proc (get-process ess-local-process-name)))
            (if (and proc (process-get proc 'dbg-active))
                (let ((str (upcase ess-debug-indicator)))
                  (setq ess-debug-minor-mode t) ; activate the keymap
                  (put-text-property 1 (1- (length str)) 'face '(:foreground "white" :background "red")
                                     str)
                  str)
              (setq ess-debug-minor-mode nil)
              ess-debug-indicator))))
(make-variable-buffer-local 'ess--dbg-mode-line-indicator)
(put 'ess--dbg-mode-line-indicator 'risky-local-variable t)

(defvar ess--dbg-mode-line-error-action
  '(:eval (or (and (ess-process-live-p)
                   (ess-process-get 'on-error-action))
              "-")))

(make-variable-buffer-local 'ess--dbg-mode-line-error-action)
(put 'ess--dbg-mode-line-error-action 'risky-local-variable t)

(defun ess--dbg-remove-empty-lines (string)
  "Remove empty lines (which interfere with evals) during debug.

This function is placed in `ess-presend-filter-functions'.
"
  ;; the process here is an ugly reliance on dynamic scope
  (if (and ess--dbg-del-empty-p (process-get process 'dbg-active))
      (replace-regexp-in-string "\n\\s *$" "" string)
    string))


(defun ess-debug-start ()
  "Start the debug session.
Add to ESS the interactive debugging functionality, breakpoints,
watch and loggers.  Integrates into ESS and iESS modes by binding
`ess-tracebug-map' to `ess-tracebug-prefix' in
`ess-mode-map' and `inferior-ess-mode-map' respectively."
  (interactive)
  (let ((dbuff (get-buffer-create (concat ess--dbg-output-buf-prefix "." ess-current-process-name "*"))) ;todo: make dbuff a string!
        (proc (ess-get-process ess-local-process-name))
        (lpn ess-local-process-name))
    (process-put proc 'dbg-buffer dbuff); buffer were the look up takes place
    (process-put proc 'dbg-active nil)  ; t if the process is in active debug state.
                                        ; Active debug states are usually those, in which prompt start with Browser[d]>
    (set-process-filter proc 'inferior-ess-tracebug-output-filter)
    (with-current-buffer (process-buffer proc)
      (unless (equal ess-dialect "R")
        (error "Can not activate the debugger for %s dialect" ess-dialect))
      (add-to-list 'ess--mode-line-process-indicator 'ess--dbg-mode-line-indicator t)
      (add-to-list 'ess--mode-line-process-indicator 'ess--dbg-mode-line-error-action t)

      (add-hook 'ess-presend-filter-functions 'ess--dbg-remove-empty-lines nil 'local))
    (with-current-buffer dbuff
      (setq ess-local-process-name lpn)
      (buffer-disable-undo)
      ;; (setq buffer-read-only nil)
      (make-local-variable 'overlay-arrow-position) ;; indicator for next-error functionality in the *ess.dbg*,  useful??
      (goto-char (point-max))
      (setq ess--dbg-buf-p t  ;; true if in  *ess.dbg* buffer
            ess--dbg-current-ref (point-marker)  ;; used by goto-error functionality
            ess--dbg-last-ref-marker (point-marker)  ;; gives marker to reference of the last debugged line
            )
      ;;      (beginning-of-line)
      ;; (setq buffer-read-only t)
      )))

(defun ess-debug-stop ()
  "End the debug session.
Kill the *ess.dbg.[R_name]* buffer."
  ;;; process plist is not removed, todo?low priority
  (interactive)
  (let ((proc (get-process ess-current-process-name))) ;;local?
    (with-current-buffer (process-buffer proc)
      (if (member ess-dialect '("XLS" "SAS" "STA"))
          (error "Can not deactivate the debugger for %s dialect" ess-dialect))
      (delq 'ess--dbg-mode-line-indicator ess--mode-line-process-indicator)
      (delq 'ess--dbg-mode-line-error-action ess--mode-line-process-indicator)
      (remove-hook 'ess-presend-filter-functions 'ess--dbg-remove-empty-lines 'local))
    (set-process-filter proc 'inferior-ess-output-filter)
    (kill-buffer (process-get proc 'dbg-buffer))
    (process-put proc 'dbg-buffer nil)
    (process-put proc 'dbg-active nil)
    ;; (when (buffer-live-p ess--dbg-buffer)
    ;;   ;; (with-current-buffer ess--dbg-buffer
    ;;   ;;   (set-buffer-modified-p nil)
    ;;   ;;   )
    ;;   (kill-buffer ess--dbg-buffer)
    ;;   )
    ))


(defun ess--make-busy-timer-function (process)
  "Display the spiner of prompt if ess-process is busy."
  `(lambda ()
     (let ((pb ,process))
       (when (eq (process-status pb) 'run) ;; only when the process is alive
         (with-current-buffer (process-buffer pb)
           (if (not (process-get pb 'busy)) ;; if ready
               (when (> ess--busy-count 0)
                 (setq ess--busy-count 0)
                 (force-mode-line-update)
                 (redisplay))
             (setq ess--busy-count (1+ (mod  ess--busy-count  (1- (length ess-busy-strings)))))
             (force-mode-line-update)
             ;; looks like redisplay is necessary for emacs > 24.4
             (redisplay)))))))

;; (ess--make-busy-prompt-function (get-process "R"))

(defun ess--dbg-is-active-p ()
  "Return t if the current R process is in active debugging state."
  (and (ess-process-live-p)
       (ess-process-get  'dbg-active)))

(defun ess--dbg-is-recover-p ()
  "Return t if the current R process is in active debugging state."
  (and (ess-process-live-p)
       (ess-process-get  'is-recover)))

(defvar ess--dbg-regexp-reference "debug \\w+ +\\(.+\\)#\\([0-9]+\\):")
(defvar ess--dbg-regexp-jump "debug \\w+ ") ;; debug at ,debug bei ,etc
(defvar ess--dbg-regexp-skip
  ;; VS[21-03-2012|ESS 12.03]: sort of forgot why recover() was for:(
  ;; don't anchor to bol secondary prompt can occur before (anything else?)
  ;; "\\(\\(?:Called from: \\)\\|\\(?:debugging in: \\)\\|\\(?:#[0-9]*: +recover()\\)\\)")
  "\\(\\(?:Called from: \\)\\|\\(?:#[0-9]*: +recover()\\)\\)")

(defvar ess--dbg-regexp-debug  "\\(\\(?:Browse[][0-9]+\\)\\|\\(?:debug: \\)\\)")
(defvar ess--dbg-regexp-selection "\\(Selection: \\'\\)")
(defvar ess--dbg-regexp-input (concat ess--dbg-regexp-debug "\\|"
                                     ess--dbg-regexp-selection))

(defvar ess--suppress-next-output? nil)

(defun ess--flush-process-output-cache (proc)
  (let ((string (with-current-buffer
                    (get-buffer-create (process-get proc 'accum-buffer-name))
                  (prog1 (buffer-string)
                    (erase-buffer)))))
    (when (> (length string) 0)
      (process-put proc 'last-flush-time (and (process-get proc 'busy)
                                              (float-time)))
      (comint-output-filter proc string)
      (ess--show-process-buffer-on-error string proc))))


(defun inferior-ess-tracebug-output-filter (proc string)
  "Standard output filter for the inferior ESS process
when `ess-debug' is active. Call `inferior-ess-output-filter'.

Check for activation expressions (defined in
`ess--dbg-regexp-debug',...), when found puts iESS in the debugging state.
If in debugging state, mirrors the output into *ess.dbg* buffer."
  (let* ((is-iess (member major-mode (list 'inferior-ess-mode 'ess-watch-mode)))
         (pbuf (process-buffer proc))
         (dbuff (process-get proc 'dbg-buffer))
         (wbuff (get-buffer ess-watch-buffer))
         (was-in-dbg (process-get proc 'dbg-active))
         (was-in-recover (process-get proc 'is-recover))
         (input-point (point-marker))
         (match-jump (string-match ess--dbg-regexp-jump string))
         (match-input (string-match ess--dbg-regexp-input string))
         (match-selection (and match-input
                               (match-string 2 string))) ;; Selection:
         (match-skip (and ess-debug-skip-first-call
                          (string-match ess--dbg-regexp-skip string)))
         (match-dbg (or match-skip (and match-input (not match-selection))))
         ;;check for main  prompt!! the process splits the output and match-end == nil might indicate this only
         ;; (prompt-regexp "^>\\( [>+]\\)*\\( \\)$") ;; default prompt only
         (prompt-replace-regexp "\\(^> \\|^\\([>+] \\)\\{2,\\}\\)\\(?1: \\)") ;; works only with the default prompt
         (is-ready (not (inferior-ess-set-status proc string)))
         (new-time (float-time))
         (last-time (process-get proc 'last-flush-time))
         (flush-timer (process-get proc 'flush-timer)))
    ;; current-buffer is still the user's input buffer here
    (ess--if-verbose-write-process-state proc string)
    (inferior-ess-run-callback proc string)
    (process-put proc 'is-recover match-selection)

    (if (or (process-get proc 'suppress-next-output?)
            ess--suppress-next-output?)
        ;; works only for surpressing short output, for time being is enough (for callbacks)
        (process-put proc 'suppress-next-output? nil)

      ;; FIXME: this should be in comint filters!!
      ;; insert \n after the prompt when necessary
      (setq string (replace-regexp-in-string prompt-replace-regexp " \n" string nil nil 1))

      ;; replace long prompts
      (when inferior-ess-replace-long+
        (setq string (replace-regexp-in-string "\\(\\+ \\)\\{4\\}\\(\\+ \\)+" ess-long+replacement string)))

      ;; COMINT
      (with-current-buffer (get-buffer-create (process-get proc 'accum-buffer-name))
        (goto-char (point-max))
        (insert string))

      ;; Need this timer here; process might be waiting for user's input!
      (when (timerp flush-timer)
        ;; cancel the timer each time we enter the filter
        (cancel-timer flush-timer)
        (process-put proc 'flush-timer nil))
      ;; ... and setup a new one
      (process-put proc 'flush-timer
                   (run-at-time .2 nil 'ess--flush-process-output-cache proc))

      (when (or (null last-time)
                (> (- new-time last-time) .5))

        ;; Very slow in long comint buffers. Probably because of some comint
        ;; interaction. Not a reall issue, as it is executed periodically
        ;; or only on first output after a command.

        (with-current-buffer pbuf
          (save-excursion
            (let ((pmark (process-mark proc)))
              (goto-char pmark)
              (when (looking-back inferior-ess-primary-prompt)
                (insert-before-markers "\n")
                (set-marker pmark (point)))))))


      (unless last-time ;; don't flush first time
        (setq last-time new-time)
        (process-put proc 'last-flush-time new-time))

      (when (or is-ready
                (process-get proc 'sec-prompt) ; for the sake of ess-eval-linewise
                ;; flush periodically
                (> (- new-time last-time) .6))

        (ess--flush-process-output-cache proc)))

    ;; WATCH
    (when (and is-ready wbuff) ;; refresh only if the process is ready and wbuff exists, (not only in the debugger!!)
      (ess-watch-refresh-buffer-visibly wbuff))

    ;; JUMP to line if debug expression was matched
    (when match-jump
      (with-current-buffer dbuff              ;; insert string in *ess.dbg* buffer
        (goto-char (point-max))
        (insert (concat "|-" string "-|")))
      (if is-iess
          (save-selected-window  ;; do not pop to the debugging line if in iESS
            (ess--dbg-goto-last-ref-and-mark dbuff t))
        (ess--dbg-goto-last-ref-and-mark dbuff)))

    ;; (with-current-buffer dbuff ;; uncomment to see the value of STRING just before  debugger exists
    ;;   (let ((inhibit-read-only t))
    ;;     (goto-char (point-max))
    ;;     (insert (concat " ---\n " string "\n ---"))
    ;;     ))

    ;; SKIP if needed
    (when (and match-skip  (not was-in-recover))
      (process-send-string proc  "n\n"))

    ;; EXIT the debugger
    (when (and was-in-dbg
               (not (or match-jump match-dbg))
               (or is-ready match-selection))
      (ess--dbg-deactivate-overlays)
      (process-put proc 'dbg-active nil)
      ;; (message "|<-- exited debugging -->|")
      (when wbuff
        (ess-watch-refresh-buffer-visibly wbuff)))

    ;; ACTIVATE the debugger and trigger electric COMMAND if entered for the first time
    (when (and (not was-in-dbg)
               (not match-selection)
               (or match-jump match-dbg))
      (unless is-iess
        (ring-insert ess--dbg-forward-ring input-point))
      (process-put proc 'dbg-active t)
      (message
       (ess--debug-keys-message-string))
      ;; (when ess--dbg-auto-single-key-p
      ;;   (ess-electric-debug t))
      )

    (when match-selection ;(and (not was-in-recover) match-selection)
      (ess-electric-selection t))))


(defvar ess-debug-minor-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map (kbd "M-C") 'ess-debug-command-continue)
    (define-key map [(control meta ?C)] 'ess-debug-command-continue-multi)
    (define-key map (kbd "M-N") 'ess-debug-command-next)
    (define-key map [(control meta ?N)] 'ess-debug-command-next-multi)
    (define-key map (kbd "M-Q") 'ess-debug-command-quit)
    (define-key map (kbd "M-U") 'ess-debug-command-up)
    map)
  "Keymap active when ESS process is in debugging state.
\\{ess-debug-minor-mode-map}")


(define-minor-mode ess-debug-minor-mode
  "Minor mode activated when ESS process is in debugging state."
  :lighter nil
  :keymap ess-debug-minor-mode-map)

(defun ess--dbg-goto-last-ref-and-mark (dbuff &optional other-window)
  "Open the most recent debug reference, and set all the
necessary marks and overlays.

It's called from `inferior-ess-tracebug-output-filter'.  DBUFF must be
the *ess.dbg* buffer associated with the process. If OTHER-WINDOW
is non nil, attempt to open the location in a different window."
  (interactive)
  (let (t-debug-position ref)
    (with-current-buffer dbuff
      (setq ref (ess--dbg-get-next-ref -1 (point-max) ess--dbg-last-ref-marker
                                       ess--dbg-regexp-reference)) ; sets point at the end of found ref
      (when ref
        (move-marker ess--dbg-last-ref-marker (point-at-eol))
        (move-marker ess--dbg-current-ref ess--dbg-last-ref-marker) ;; each new step repositions the current-ref!
        ))
    (when ref
      (if (apply 'ess--dbg-goto-ref other-window ref)
          (progn ;; if referenced  buffer is found put overlays
            (setq t-debug-position (copy-marker (point-at-bol)))
            (if (equal t-debug-position ess--dbg-current-debug-position)
                (progn ;; highlights the overlay for ess--dbg-blink-interval seconds
                  (overlay-put ess--dbg-current-debug-overlay 'face 'ess--dbg-blink-same-ref-face)
                  (run-with-timer ess-debug-blink-interval nil
                                  (lambda ()
                                    (overlay-put ess--dbg-current-debug-overlay 'face 'ess-debug-current-debug-line-face))))
                                        ;else
              (ess--dbg-activate-overlays)))
        ;;else, buffer is not found: highlight and give the corresponding message
        (overlay-put ess--dbg-current-debug-overlay 'face 'ess--dbg-blink-ref-not-found-face)
        (run-with-timer ess-debug-blink-interval nil
                        (lambda ()
                          (overlay-put ess--dbg-current-debug-overlay 'face 'ess-debug-current-debug-line-face)))
        (message "Reference %s not found" (car ref))))))

(defun ess--dbg-goto-ref (other-window file line &optional col)
  "Opens the reference given by FILE, LINE and COL,
Try to open in a different window if OTHER-WINDOW is nil.  Return
the buffer if found, or nil otherwise be found.
`ess--dbg-find-buffer' is used to find the FILE and open the
associated buffer. If FILE is nil return nil.
"
  (let ((mrk (car (ess--dbg-create-ref-marker file line col)))
        (lpn ess-local-process-name))
    (when mrk
      (if (not other-window)
          (switch-to-buffer (marker-buffer mrk))
        (pop-to-buffer (marker-buffer mrk)))
      ;; set or re-set to lpn as this is the process with debug session on
      (setq ess-local-process-name lpn)
      (goto-char mrk))))

;; temporary, hopefully org folks implement something similar
(defvar org-babel-tangled-file nil)

(defun ess--dbg-create-ref-marker (file line &optional col)
  "Create markers to the reference given by FILE, LINE and COL.
Return list of two markers MK-start and MK-end. MK-start is the
position of error. Mk-end is the end of the line where error
occurred.

If buffer associated with FILE is not found, or line is nil, or
TB-INDEX is not found return nil.
"
  (if (stringp line) (setq line (string-to-number line)))
  (if (stringp col) (setq col (string-to-number col)))
  (let* ((srcref (gethash file ess--srcrefs))
         (file (replace-regexp-in-string "^\n" "" ;; hack for gnu regexp
                                         (or (car srcref) file)))
         (tb-index (cadr srcref))
         (buffer (ess--dbg-find-buffer file))
         pos)
    (when (and buffer line)
      (save-excursion
        (with-current-buffer buffer
          (save-restriction
            (widen) ;; how does this behave in narrowed buffers? tothink:
            (goto-char 1)
            (setq pos (point))
            (when tb-index
              (while (and (not (eq tb-index (get-text-property pos 'tb-index)))
                          (setq pos (next-single-property-change pos 'tb-index)))))
            (unless pos
              ;; use beg position if index not found
              (setq pos (nth 2 srcref)))
            (when pos
              (goto-char pos)
              (forward-line (1- line))
              (if col
                  (goto-char (+ (point-at-bol) col))
                (back-to-indentation))
              (when org-babel-tangled-file
                (org-babel-tangle-jump-to-org))
              (list (point-marker) (copy-marker (point-at-eol))))))))))


(defun ess--dbg-find-buffer (filename)
  "Find a buffer for file FILENAME.
If FILENAME is not found at all, ask the user where to find it if
`ess--dbg-ask-for-file' is non-nil.  Search the directories in
`ess-tracebug-search-path'."
  (let ((dirs ess-tracebug-search-path)
        (spec-dir default-directory)
        buffsym buffer thisdir fmts name buffername)
    (setq dirs (cons spec-dir dirs)) ;; current does not have priority!! todo:should be R working dir
    ;; 1. search already open buffers for match (associated file might not even exist yet)
    (dolist (bf (buffer-list))
      (with-current-buffer  bf
        (when (and buffer-file-name
                   (or (and (file-name-absolute-p filename)
                            (string-match (format "%s\\'" filename) buffer-file-name))
                       (equal filename (file-name-nondirectory buffer-file-name))))
          (setq buffer bf)
          (return))))
    ;; 2. The file name is absolute.  Use its explicit directory as
    ;; the first in the search path, and strip it from FILENAME.
    (when (and (null  buffer)
               (file-name-absolute-p filename))
      (setq filename (abbreviate-file-name (expand-file-name filename))
            dirs (cons (file-name-directory filename) dirs)
            filename (file-name-nondirectory filename)))
    ;; 3. Now search the path.
    (while (and (null buffer)
                dirs )
      (setq thisdir (car dirs))
      (setq name (expand-file-name filename thisdir)
            buffer (and (file-exists-p name)
                        (find-file-noselect name)))
      (setq dirs (cdr dirs)))
    ;; 4. Ask for file if not found (tothink: maybe remove this part?)
    (if (and (null buffer)
             ess-debug-ask-for-file)
        (save-excursion            ;This save-excursion is probably not right.
          (let* ((pop-up-windows t)
                 (name (read-file-name
                        (format "Find next line in (default %s): "  filename)
                        spec-dir filename t nil))
                 (origname name))
            (cond
             ((not (file-exists-p name))
              (message "Cannot find file `%s'" name)
              (ding) (sit-for 2))
             ((and (file-directory-p name)
                   (not (file-exists-p
                         (setq name (expand-file-name filename name)))))
              (message "No `%s' in directory %s" filename origname)
              (ding) (sit-for 2))
             (t
              (setq buffer (find-file-noselect name)))))))
    ;; nil if not found
    buffer))

(defun ess--dbg-get-next-ref (n &optional pt BOUND REG nF nL nC)
  "Move point to the next reference in the *ess.dbg* buffer.

Must be called from *ess.dbg* buffer.
It returns the reference in the form (file line col) /all strings/ ,
or NIL if not found .  Prefix arg N says how many error messages
to move forwards (or backwards, if negative).  Optional arg PT,
if non-nil, specifies the value of point to start looking for the
next message, default to (point).  BOUND is the limiting position
of the search.  REG is the regular expression to search with.  nF
- sub-expression of REG giving the 'file'; defaults to 1.  nL -
giving the 'line'; defaults to 2.  nC - sub-expr giving the
'column'; defaults to 3.
"
  (interactive "p")
  (unless ess--dbg-buf-p
    (error "Not in *ess.dbg* buffer."))
  (setq nF (or nF 1)
        nL (or nL 2)
        nC (or nC 3))
  (or pt (setq pt (point)))
  ;; (message "ess--dbg-last-ref-marker%s vs  pt%s vs point-max%s" ess--dbg-last-ref-marker pt (point-max))
  (goto-char pt)
  (if (search-forward-regexp REG BOUND t n)
      (list (match-string nF) (match-string-no-properties nL) (match-string-no-properties nC))
    nil))

(defun ess--dbg-next-ref-function (n &optional reset)
  "Advance to the next reference and visit the location
given by the reference.  This is the value of
`next-error-function' in *ess.dbg* buffers."
  (interactive "p")
  (if reset
      (set-marker ess--dbg-current-ref ess--dbg-last-ref-marker))
  (let ((loc (ess--dbg-get-next-ref n nil ess--dbg-current-ref))  ;; moves point to next/prev ref if any
                                        ; loc is  (file . line_nr)
        dbuff)
    (if loc
        (progn
          (set-marker ess--dbg-current-ref (line-end-position))
          (set-marker overlay-arrow-position (line-beginning-position))
          (setq dbuff (ess--dbg-find-buffer  (car loc)))
          (switch-to-buffer dbuff)
          (save-restriction
            (widen)
            (goto-char 1)
            (forward-line (1- (cdr loc))))
          (move-marker ess--dbg-current-debug-position (line-beginning-position)) ; move the overlay-arrow
          (back-to-indentation))
      (if (>= 0 (or n 1))
          (error "Moved past first debug line")
        (error "Moved past last debug line")))))


;; not used; remove in 13.09
(defvar ess-electric-debug-map
  (let ((map (make-sparse-keymap)))
    (define-key map "c" 'ess-debug-command-continue)
    (define-key map "C" 'ess-debug-command-continue-multi)
    (define-key map "n" 'ess-debug-command-next)
    (define-key map "N" 'ess-debug-command-next-multi)
    (define-key map "q" 'ess-debug-command-quit)
    (define-key map "u" 'ess-debug-command-up)
    map)
  "Keymap used to define commands for single key input mode.
This commands are triggered by `ess-electric-debug' .
\\{ess-electric-debug-map}")
(make-obsolete-variable 'ess-electric-debug-map nil "ESS 13.05")

(defun ess--debug-keys-message-string (&optional map)
  (let ((overriding-local-map (or map ess-debug-minor-mode-map)))
    (substitute-command-keys
     (mapconcat 'identity
                '("(\\[ess-debug-command-continue])cont"
                  "(\\[ess-debug-command-continue-multi])cont-multi"
                  "(\\[ess-debug-command-next])next"
                  "(\\[ess-debug-command-next-multi])next-multi"
                  "(\\[ess-debug-command-up])up"
                  "(\\[ess-debug-command-quit])quit")
                " "))))

;; not used anywhere; remove in ESS 13.09
(defun ess-electric-debug (&optional wait)
  "Call commands defined in `ess-electric-debug-map'.
Single-key input commands are those that once invoked do not
requre the prefix command for subsequent invocation.

For example, if the prefix key is 'C-c C-t' and
`ess-debug-command-next' is bound to 'n' and `ess-debug-command-continue' is
bound to 'c' then 'C-c C-t n n c' executes `ess-debug-command-next'
twice and `ess-debug-command-continue' once. Any other input not defined
in `ess-electric-debug-map' will cause the exit from single-key
input mode.

If WAIT is t, wait for next input and ignore the keystroke which
triggered the command."
  (interactive)
  (let ((help-mess (ess--debug-keys-message-string
                    ess-electric-debug-map)))
    (ess--execute-electric-command
     ess-electric-debug-map help-mess wait
     (not (ess-process-get 'dbg-active)))))

(define-obsolete-function-alias
  'ess-singlekey-debug 'ess-electric-debug  "ESS 13.05")
(make-obsolete 'ess-electric-debug nil "ESS 13.05")

(defun ess-electric-selection (&optional wait)
  "Call commands defined in `ess-electric-selection-map'.
Single-key input commands are those, which once executed do not
requre the prefix command for subsequent invocation. See
`ess-electric-debug' for more.

If WAIT is t, wait for next input and ignore the keystroke which
triggered the command."

  (interactive)
  (ess--execute-electric-command ess-electric-selection-map
                                 "Selection: " wait
                                 (not (ess-process-get 'is-recover))))

(make-obsolete 'ess-singlekey-selection 'ess-electric-selection "ESS 13.05")

(defun ess-debug-command-digit (&optional ev)
  "Digit commands in selection mode.
If suplied ev must be a proper key event or a string representing the digit."
  (interactive)
  (unless ev
    (setq ev last-command-event))
  (let* ((ev-char (if (stringp ev)
                      ev
                    (char-to-string (event-basic-type ev))))
         (proc (get-process ess-current-process-name))
         (mark-pos (marker-position (process-mark proc)))
         (comint-prompt-read-only nil)
         prompt  depth)
    (if (process-get proc 'is-recover)
        (with-current-buffer (process-buffer proc)
          (goto-char mark-pos)
          (save-excursion
            (when (re-search-backward "\\(?: \\|^\\)\\([0-9]+\\):[^\t]+Selection:" ess--tb-last-input t)
              (setq depth (string-to-number (match-string 1)))
              (when (> depth 9)
                (setq ev-char (ess-completing-read "Selection" (mapcar 'number-to-string
                                                                       (number-sequence depth 0 -1))
                                                   nil t ev-char nil)))))
          (setq prompt (delete-and-extract-region  (point-at-bol) mark-pos))
          (insert (concat  prompt ev-char "\n"))
          (ess-send-string proc ev-char)
          (move-marker (process-mark proc) (max-char)))
      (error "Recover is not active"))))

(defun ess-debug-command-next (&optional ev)
  "Step next in debug mode.
Equivalent to 'n' at the R prompt."
  (interactive)
  (if (not (ess--dbg-is-active-p))
      (error "Debugger is not active")
    (if (ess--dbg-is-recover-p)
        (ess-send-string (get-process ess-current-process-name) "0")
      (ess-send-string (get-process ess-current-process-name) "n"))))

(defun ess-debug-command-next-multi (&optional ev N)
  "Ask for N and step (n) N times in debug mode."
  (interactive)
  (if (not (ess--dbg-is-active-p))
      (error "Debugger is not active")
    (let ((N (or N (read-number "Number of steps: " 10)))
          (proc (get-process ess-local-process-name))
          (ess--suppress-next-output? t))
      (while (and (ess--dbg-is-active-p) (> N 0))
        (ess-debug-command-next)
        (ess-wait-for-process proc)
        (setq N (1- N))))
    (ess-debug-command-next)))

(defun ess-debug-command-continue-multi (&optional ev N)
  "Ask for N, and continue (c) N times in debug mode."
  (interactive)
  (if (not (ess--dbg-is-active-p))
      (error "Debugger is not active")
    (let ((N (or N (read-number "Number of continuations: " 10)))
          (proc (get-process ess-local-process-name))
          (ess--suppress-next-output? t))
      (while (and (ess--dbg-is-active-p) (> N 1))
        (ess-debug-command-continue)
        (ess-wait-for-process proc)
        (setq N (1- N))))
    (ess-debug-command-continue)))


(defun ess-debug-command-up (&optional ev)
  "Step up one call frame.
Equivalent to 'n' at the R prompt."
  (interactive)
  (if (not (ess--dbg-is-active-p))
      (error "Debugger is not active")
    (let ((proc (get-process ess-local-process-name)))
      (ess-send-string proc
                       "try(browserSetDebug(), silent=T)\nc\n"))))

;; (defun ess-debug-previous-error (&optional ev)
;;   "Go to previous reference during the debug process.
;; R doesn't support step backwards. This command just takes you  through
;; debug history."
;;   (interactive)
;;   (previous-error))

(defun ess-debug-command-quit (&optional ev)
  "Quits the browser/debug in R process.
 Equivalent to 'Q' at the R prompt."
  (interactive)
  (let ((proc (get-process ess-current-process-name) ))
    (if (not (or (process-get proc 'dbg-active)
                 (process-get proc 'is-recover)))
        (error "Debugger is not active")
      (when (ess--dbg-is-recover-p)
        (ess-send-string proc "0")
        ;; if recover is called in a loop the following stalls emacs
        ;; (ess-wait-for-process proc nil 0.05)
        )
      (if (and (process-get proc 'dbg-active)
               (not (process-get proc 'is-recover))); still in debug mode
          (ess-send-string proc "Q")))))

(defun ess-debug-command-continue (&optional ev)
  "Continue the code execution.
 Equivalent of 'c' at the R prompt."
  (interactive)
  (let ((proc (get-process ess-current-process-name)))
    (if (not (or (process-get proc 'dbg-active)
                 (process-get proc 'is-recover)))
        (error "Debugger is not active")
      (when (ess--dbg-is-recover-p)
        (ess-send-string proc "0")
        ;; (ess-wait-for-process proc nil 0.05) <- when in a loop, gets stuck
        ) ;; get out of recover mode
      (if (and (process-get proc 'dbg-active) ; still in debug mode
               (not (process-get proc 'is-recover))); still in debug mode
          (ess-send-string proc "c")))))

(defun ess-tracebug-set-last-input (&rest ARGS)
  "Move `ess--tb-last-input' marker to the process mark.
ARGS are ignored to allow using this function in process hooks."
  (let* ((last-input-process (get-process ess-local-process-name))
         (last-input-mark (copy-marker (process-mark last-input-process))))
    (with-current-buffer (process-buffer last-input-process)
      (when (local-variable-p 'ess--tb-last-input) ;; TB might not be active in all processes
        (save-excursion
          (setq ess--tb-last-input last-input-mark)
          (goto-char last-input-mark)
          (inferior-ess-move-last-input-overlay))))))

(defun ess--tb-R-source-current-file (&optional filename)
  "Save current file and source it in the .R_GlobalEnv environment."
  ;; fixme: this sucks as it doesn't use ess-load-command and the whole thing
  ;; seems redundand to the ess-load-file
  (interactive)
  (ess-force-buffer-current "R process to use: ")
  (let ((proc (get-process ess-local-process-name))
        (file (or filename buffer-file-name)))
    (if (or ess-developer
            (ess-get-process-variable 'ess-developer))
        (ess-developer-source-current-file filename)
      (if (not file)
          ;; source the buffer content, org-mode, *scratch* etc.
          (let ((ess-inject-source t))
            (ess-tracebug-send-region proc (point-min) (point-max) nil
                                      (format "Sourced buffer '%s'" (propertize (buffer-name) 'face 'font-lock-function-name-face))))
        (when (buffer-modified-p) (save-buffer))
        (save-selected-window
          (ess-switch-to-ESS t))
        (ess-send-string (get-process ess-current-process-name)
                         (concat "\ninvisible(eval({source(file=\"" filename
                                 "\")\n cat(\"Sourced file '" filename "'\\n\")}, env=globalenv()))"))))))

;;;_ + BREAKPOINTS

(defface ess-bp-fringe-inactive-face
  '((((class color) (background light) (min-colors 88)) (:foreground "DimGray"))
    (((class color) (background dark) (min-colors 88))  (:foreground "LightGray"))
    (((background light) (min-colors 8))  (:foreground "blue"))
    (((background dark) (min-colors 8))  (:foreground "cyan")))
  "Face used to highlight inactive breakpoints."
  :group 'ess-debug)

(defface ess-bp-fringe-logger-face
  '((((class color) (background light) (min-colors 88)) (:foreground "dark red"))
    (((class color) (background dark) (min-colors 88))  (:foreground "tomato1"))
    (((background light) (min-colors 8))  (:foreground "blue"))
    (((background dark) (min-colors 8))  (:foreground "cyan")))
  "Face used to highlight loggers."
  :group 'ess-debug)

(defface ess-bp-fringe-browser-face
  '((((class color) (background light) (min-colors 88)) (:foreground "medium blue"))
    (((class color) (background dark) (min-colors 88))  (:foreground "deep sky blue"))
    (((background light) (min-colors 8))  (:foreground "blue"))
    (((background dark) (min-colors 8))  (:foreground "cyan")))
  "Face used to highlight 'browser' breakpoints."
  :group 'ess-debug)

(defface ess-bp-fringe-recover-face
  '((((class color) (background light) (min-colors 88)) (:foreground "dark magenta"))
    (((class color) (background dark) (min-colors 88))  (:foreground "magenta"))
    (((background light) (min-colors 8))  (:foreground "magenta"))
    (((background dark) (min-colors 8))  (:foreground "magenta")))
  "Face used to highlight 'recover' breakpoints fringe."
  :group 'ess-debug)

(defvar ess--bp-identifier 1)
(defcustom ess-bp-type-spec-alist
  '((browser "browser(expr=is.null(.ESSBP.[[%s]]))" "B>\n"   filled-square  ess-bp-fringe-browser-face)
    (recover "recover()" "R>\n"   filled-square  ess-bp-fringe-recover-face))
  "List of lists of breakpoint types.
Each sublist  has five elements:
1- symbol giving the name of specification
2- R expression to be inserted (%s is substituted with unique identifier).
3- string to be displayed instead of the expression
4- fringe bitmap to use
5- face for fringe and displayed string."
  :group 'ess-debug
  :type '(alist :key-type symbol
                :value-type (group string string symbol face)))

(defcustom ess-bp-inactive-spec
  '(inactive     "##"    filled-square  ess-bp-fringe-inactive-face)
  "List giving the inactive breakpoint specifications."
  ;; List format is identical to that of the elements of
  ;; `ess-bp-type-spec-alist' except that the second element giving
  ;; the R expression is meaningless here." ;;fixme: second element is missing make it nil for consistency with all other specs
  :group 'ess-debug)

(defcustom ess-bp-conditional-spec
  '(conditional     "browser(expr={%s})"  "CB[ %s ]>\n"  question-mark  ess-bp-fringe-browser-face)
  "List giving the conditional breakpoint specifications.
List format is identical to that of the elements of
`ess-bp-type-spec-alist'.  User is asked for the conditional
expression to be replaced instead of %s in the second and third
elements of the specifications."
  :group 'ess-debug)

(defcustom ess-bp-logger-spec
  '(logger     ".ess_log_eval('%s')"  "L[ \"%s\" ]>\n"  hollow-square  ess-bp-fringe-logger-face)
  "List giving the loggers specifications.
List format is identical to that of `ess-bp-type-spec-alist'."
  :group 'ess-debug)


(defun ess-bp-get-bp-specs (type &optional condition no-error)
  "get specs for TYPE "
  (let ((spec-alist (cond
                     ((eq type 'conditional)
                      (let ((tl (copy-sequence  ess-bp-conditional-spec)))
                        (when (eq (length condition) 0)
                          (setq condition "TRUE"))
                        (setcar (cdr tl) (format (cadr tl) condition))
                        (setcar (cddr tl) (format (caddr tl) condition))
                        (list tl)))
                     ((eq type 'logger)
                      (let ((tl (copy-sequence ess-bp-logger-spec)))
                        (when (eq (length condition) 0)
                          (setq condition "watchLog"))
                        (setcar (cdr tl) (format (cadr tl) condition))
                        (setcar (cddr tl) (format (caddr tl) condition))
                        (list tl)))
                     (t ess-bp-type-spec-alist))))
    (or (assoc type spec-alist)
        (if no-error
            nil
          (error "Undefined breakpoint type %s" type)))))

(defun ess-bp-create (type &optional condition no-error)
  "Set breakpoint for the current line.
 Returns the begging position of the hidden text."
  (let* ((bp-specs (ess-bp-get-bp-specs type condition no-error))
         (init-pos (point-marker))
         (fringe-bitmap (nth 3 bp-specs))
         (fringe-face (nth 4 bp-specs))
         (displ-string (nth 2 bp-specs))
         (bp-id (format "\"@%s@\""
                        (setq ess--bp-identifier (1+ ess--bp-identifier))))
         (bp-command (concat  (format (nth 1 bp-specs) bp-id)
                              "##:ess-bp-end:##\n"))
         (bp-length (length bp-command))
         (dummy-string (format "##:ess-bp-start::%s@%s:##\n"  (car bp-specs) condition))
         (dummy-length (length dummy-string))
         insertion-pos)
    (when bp-specs
      (set-marker init-pos (1+ init-pos))
      (setq displ-string (propertize displ-string
                                     'face fringe-face
                                     'font-lock-face fringe-face))
      (setq bp-command (propertize bp-command
                                   'ess-bp t
                                   'bp-id bp-id
                                   'bp-active t
                                   'intangible 'ess-bp
                                   'rear-nonsticky '(intangible ess-bp bp-type)
                                   'bp-type type
                                   'bp-substring 'command
                                   'display displ-string))
      (setq dummy-string (propertize
                          (ess-tracebug--propertize dummy-string fringe-bitmap fringe-face "*")
                          'ess-bp t
                          'intangible 'ess-bp
                          'bp-type type
                          'bp-substring 'dummy))
      (ess-tracebug--set-left-margin)
      (back-to-indentation)
      (setq insertion-pos (point) )
      (insert (concat   dummy-string bp-command))
      (indent-for-tab-command)
      (goto-char (1- init-pos))  ;; sort of save-excursion
      insertion-pos)))


(defun ess-bp-recreate-all ()
  "internal function to recreate all bp"
  (save-excursion
    (save-restriction
      (with-silent-modifications
        (widen)
        (goto-char (point-min))
        (while (re-search-forward
                "\\(##:ess-bp-start::\\(.*\\):##\n\\)\\(.+##:ess-bp-end:##\n\\)" nil t)
          (let ((dum-beg (match-beginning 1))
                (dum-end (match-end 1))
                (comm-beg (match-beginning 3))
                (comm-end (match-end 3))
                (type (match-string 2))
                (bp-command (match-string 3))
                bp-id dum-props condition)
            (when (string-match "^\\(\\w+\\)@\\(.*\\)\\'" type)
              (setq condition (match-string 2 type))
              (setq type (match-string 1 type)))
            (setq bp-id
                  (if (string-match "\"@[0-9]+@\"" bp-command)
                      (match-string 0 bp-command)
                    (setq ess--bp-identifier (1+ ess--bp-identifier))))
            (setq type (intern type))
            (let* ((bp-specs (ess-bp-get-bp-specs  type condition t))
                   (displ-string (nth 2 bp-specs))
                   (fringe-face (nth 4 bp-specs))
                   (fringe-bitmap (nth 3 bp-specs)))
              (when bp-specs
                (setq displ-string (propertize displ-string
                                               'face fringe-face
                                               'font-lock-face fringe-face))
                (add-text-properties comm-beg comm-end
                                     (list 'ess-bp t
                                           'bp-id bp-id
                                           'intangible 'ess-bp
                                           'rear-nonsticky '(intangible ess-bp bp-type)
                                           'bp-type type
                                           'bp-substring 'command
                                           'display displ-string))
                (setq dum-props
                      (if window-system
                          (list 'display (list 'left-fringe fringe-bitmap fringe-face))
                        (list 'display (list '(margin left-margin)
                                             (propertize "dummy"
                                                         'font-lock-face fringe-face
                                                         'face fringe-face)))))
                (add-text-properties dum-beg dum-end
                                     (append dum-props
                                             (list 'ess-bp t
                                                   'intangible 'ess-bp
                                                   'bp-type type
                                                   'bp-substring 'dummy)))
                ;; (when comment-beg
                ;;   (add-text-properties comment-beg comment-end
                ;;                        (list 'ess-bp t
                ;;                              'bp-id bp-id
                ;;                              'intangible 'ess-bp
                ;;                              'display (propertize (nth 1 ess-bp-inactive-spec) 'face fringe-face)
                ;;                              'bp-type type
                ;;                              'bp-substring 'comment)))
                ))))))))

(add-hook 'R-mode-hook 'ess-bp-recreate-all)


(defun ess-bp-get-bp-position-nearby ()
  "Return the cons (beg . end) of breakpoint limit points
closest to the current position.  Only currently visible region of the
buffer is searched.  This command is intended for use in
interactive commands like `ess-bp-toggle-state' and `ess-bp-kill'.
Use `ess-bp-previous-position' in programs."
  (interactive)
  (let* ( (pos-end (if (get-char-property (1- (point)) 'ess-bp)
                       (point)
                     (previous-single-property-change (point) 'ess-bp nil (window-start))))
          (pos-start (if (get-char-property (point) 'ess-bp)    ;;check for bobp
                         (point)
                       (next-single-property-change (point) 'ess-bp nil (window-end))))
          pos dist-up dist-down)
    (if (not (eq pos-end (window-start)))
        (setq dist-up (- (point) pos-end)))
    (if (not (eq pos-start (window-end)))
        (setq dist-down (- pos-start (point))))
    (if (and dist-up dist-down)
        (if (< dist-up dist-down)
            (cons (previous-single-property-change pos-end 'ess-bp nil (window-start)) pos-end)
          (cons pos-start (next-single-property-change pos-start 'ess-bp nil (window-end))))
      (if dist-up
          (cons (previous-single-property-change pos-end 'ess-bp nil (window-start)) pos-end)
        (if dist-down
            (cons pos-start (next-single-property-change pos-start 'ess-bp nil (window-end))))))))


(defun ess-bp-previous-position ()
  "Returns the cons (beg . end) of breakpoint limit points closest
to the current position, nil if not found. "
  (let* ( (pos-end (if (get-char-property (1- (point)) 'ess-bp)
                       (point)
                     (previous-single-property-change (point) 'ess-bp ))))
    (if pos-end
        (cons (previous-single-property-change pos-end 'ess-bp) pos-end))))

(defun ess-bp-set ()
  (interactive)
  (let* ((pos (ess-bp-get-bp-position-nearby))
         (same-line (and pos
                         (<=  (point-at-bol) (cdr pos))
                         (>= (point-at-eol) (car pos))))
         (types ess-bp-type-spec-alist)
         (ev last-command-event)
         (com-char  (event-basic-type ev))
         bp-type)
    (when same-line
      ;; set bp-type to next type in types
      (setq bp-type (get-text-property (car pos) 'bp-type))
      (setq types (cdr (member (assq bp-type types) types))) ; nil if bp-type is last in the list
      (if (null types) (setq types ess-bp-type-spec-alist))
      (ess-bp-kill)
      (indent-for-tab-command))
    (setq bp-type (pop types))
    (ess-bp-create (car bp-type))
    (while  (eq (event-basic-type (setq ev (read-event (format "'%c' to cycle" com-char))))
                com-char)
      (if (null types) (setq types ess-bp-type-spec-alist))
      (setq bp-type (pop types))
      (ess-bp-kill)
      (ess-bp-create (car bp-type))
      (indent-for-tab-command))
    (push ev unread-command-events)))


(defun ess-bp-set-conditional (condition)
  (interactive "sBreakpoint condition: ")
  (ess-bp-create 'conditional condition)
  (indent-for-tab-command))

(defun ess-bp-set-logger (name)
  (interactive "sLogger name : ")
  (ess-bp-create 'logger name)
  (indent-for-tab-command))

(defun ess-bp-kill (&optional interactive?)
  "Remove the breakpoint nearby"
  (interactive "p")
  (let ((pos (ess-bp-get-bp-position-nearby))
        (init-pos (make-marker)))
    (if (null pos)
        (if interactive? (message "No breakpoints nearby"))
      (if (eq (point) (point-at-eol))
          (goto-char (1- (point)))) ;; work-arround for issue  3
      (set-marker init-pos  (point))
      (goto-char (car pos))
      (delete-region (car pos) (cdr pos))
      (indent-for-tab-command)
      (goto-char init-pos)
      (if (eq (point) (point-at-eol)) (forward-char)))))

(defun ess-bp-kill-all nil
  "Delete all breakpoints in current buffer."
  (interactive)
  (let ((count 0)
        (init-pos (make-marker))
        pos)
    (set-marker init-pos (1+ (point)))
    (save-excursion   ;; needed if error
      (goto-char (point-max))
      (while (setq pos (ess-bp-previous-position))
        (goto-char (car pos))
        (delete-region (car pos) (cdr pos))
        (indent-for-tab-command)
        (setq count (1+ count)))
      (if (eq count 1)
          (message "Killed 1 breakpoint")
        (message "Killed %d breakpoint(s)" count)))
    (goto-char (1- init-pos))))


(defun ess-bp-toggle-state ()
  "Toggle the breakpoint between active and inactive states.

For standard breakpoints, the effect of this command is
immediate, that is you don't need to source your code and it
works even in the process of debugging.

For loggers, recover and conditional breakpoints this command
just comments the breakpoint in the source file.

If there is no active R session, this command triggers an error."
  (interactive)
  (unless (and ess-local-process-name
               (get-process ess-local-process-name))
    (error "No R session in this buffer"))
  (save-excursion
    (let ((pos (ess-bp-get-bp-position-nearby))
          (fringe-face (nth 3 ess-bp-inactive-spec))
          (inhibit-point-motion-hooks t) ;; deactivates intangible property
          bp-id beg-pos-dummy end-pos-comment bp-specs beg-pos-command)
      (if (null pos)
          (message "No breakpoints in the visible region")
        (goto-char (car pos))
        (setq beg-pos-command (previous-single-property-change
                               (cdr pos) 'bp-substring nil (car pos))
              bp-id (get-char-property beg-pos-command 'bp-id))
        (goto-char beg-pos-command)
        (if (get-char-property beg-pos-command 'bp-active)
            (progn
              (put-text-property  (car pos) beg-pos-command ;; dummy display change
                                  'display (list 'left-fringe (nth 2 ess-bp-inactive-spec) fringe-face))
              (put-text-property beg-pos-command (cdr pos)
                                 'bp-active nil)
              (ess-command (format ".ESSBP.[[%s]] <- TRUE\n" bp-id)))
          (setq bp-specs (assoc (get-text-property (point) 'bp-type) ess-bp-type-spec-alist))
          (put-text-property beg-pos-command (cdr pos)
                             'bp-active t)
          (put-text-property  (car pos) beg-pos-command
                              'display (list 'left-fringe (nth 3 bp-specs) (nth 4 bp-specs)))
          (ess-command (format ".ESSBP.[[%s]] <- NULL\n" bp-id))
          ;; (insert (propertize "##"
          ;;                     'ess-bp t
          ;;                     'intangible 'ess-bp
          ;;                     'display (propertize (nth 1 ess-bp-inactive-spec) 'face fringe-face)
          ;;                     'bp-type (get-char-property (point) 'bp-type)
          ;;                     'bp-substring 'comment))
          )))))


(defun ess-bp-make-visible ()
  "Makes bp text visible."
  (interactive)
  (let ((pos (ess-bp-get-bp-position-nearby)))
    (set-text-properties (car pos) (cdr pos) (list 'display nil))))



(defun ess-bp-next nil
  "Goto next breakpoint."
  (interactive)
  (let ((cur-pos (point))
        (bp-pos (next-single-property-change (point) 'ess-bp)))
    (when bp-pos
      (save-excursion
        (goto-char bp-pos)
        (when (get-text-property (1- (point)) 'ess-bp)
          (setq bp-pos (next-single-property-change bp-pos 'ess-bp)))))
    (if bp-pos
        (goto-char bp-pos)
      (message "No breakpoints found"))))


(defun ess-bp-previous nil
  "Goto previous breakpoint."
  (interactive)
  (let ((cur-pos (point))
        (bp-pos (previous-single-property-change (point) 'ess-bp)))
    (if bp-pos
        (goto-char (or (previous-single-property-change bp-pos 'ess-bp)
                       bp-pos))
      ;;
      (message "No breakpoints before the point found"))))

;;;_ + WATCH

(defvar ess-watch-command
  ;; assumes that every expression is a structure of length 1 as returned by parse.
  ".ess_watch_eval()\n")

(if (fboundp 'define-fringe-bitmap) ;;not clear to me why is this not bound in SSH session? - :todo check
    (define-fringe-bitmap 'current-watch-bar
      [#b00001100] nil nil '(top t)))

(defun ess-tracebug--set-left-margin ()
  "Set the margin on non-X displays"
  (unless window-system
    (when (= left-margin-width 0)
      (setq left-margin-width 1)
      (set-window-buffer (selected-window) (current-buffer)))))

(defun ess-watch-mode ()
  "Major mode in ess-watch window.
\\{ess-watch-mode-map}"
  (let ((cur-block (max 1 (ess-watch-block-at-point)))
        (dummy-string
         (ess-tracebug--propertize "|" 'current-watch-bar 'font-lock-keyword-face)))
    (kill-all-local-variables)
    (ess-tracebug--set-left-margin)
    (make-local-variable 'revert-buffer-function)
    (setq revert-buffer-function 'ess-watch-revert-buffer)
    (use-local-map ess-watch-mode-map)
    (setq major-mode 'ess-watch-mode)
    (setq mode-name (concat "watch " ess-current-process-name))
    (turn-on-font-lock)
    (setq ess-watch-current-block-overlay
          (make-overlay (point-min) (point-max)))
    (overlay-put ess-watch-current-block-overlay 'line-prefix dummy-string)
    (overlay-put ess-watch-current-block-overlay 'face 'ess-watch-current-block-face)
    (ess-watch-set-current cur-block) ;;
    (when (require 'face-remap nil t)
      ;; scale the font
      (setq text-scale-mode-amount ess-watch-scale-amount)
      (text-scale-mode 1)                                        ;    (text-scale-mode -1) ;;restore to default
      )))

(defun ess-watch ()
  "Run ess-watch mode on R objects.
This is the trigger function.  See documentation of
`ess-watch-mode' for more information.

\\{ess-watch-mode-map}
"
  (interactive)
  (ess-force-buffer-current)
  (let ((wbuf (get-buffer-create ess-watch-buffer))
        (pname ess-local-process-name)
        (alist (symbol-value ess-local-customize-alist)))
    (set-buffer wbuf)
    (ess-setq-vars-local alist)
    (setq ess-local-process-name pname)
    (ess-watch-mode)
    (ess-watch-refresh-buffer-visibly wbuf) ;; evals the ess-command and displays the buffer if not visible
    (pop-to-buffer wbuf)
    (set-window-dedicated-p (selected-window) 1) ;; not strongly dedicated
    ))


(defun ess-watch-refresh-buffer-visibly (wbuf &optional sleep no-prompt-check)
  "Eval `ess-watch-command' and direct the output into the WBUF.
Call `ess-watch-buffer-show' to make the buffer visible, without
selecting it.

This function is used for refreshing the watch window after each step during
the debugging."
  ;; assumes that the ess-watch-mode is on!!
  ;; particularly ess-watch-current-block-overlay is installed
  (interactive)
  (ess-watch-buffer-show wbuf) ;; if visible do nothing
  (let ((pname ess-local-process-name)) ;; watch might be used from different dialects, need to reset
    (with-current-buffer wbuf
      (let ((curr-block (max 1 (ess-watch-block-at-point)))) ;;can be 0 if
        (setq buffer-read-only nil)
        (when pname
          (setq ess-local-process-name pname))
        (ess-command  ess-watch-command wbuf sleep no-prompt-check)
        ;; delete the ++++++> line  ;; not very reliable but works fine so far.
        (goto-char (point-min))
        (delete-region (point-at-bol) (+ 1 (point-at-eol)))
        (ess-watch-set-current curr-block)
        (set-window-point (get-buffer-window wbuf) (point))
        (setq buffer-read-only t)))))

(defun ess-watch-buffer-show (buffer-or-name)
  "Make watch buffer BUFFER-OR-NAME visible, and position acordingly.
If already visible, do nothing.

Currently the only positioning rule implemented is to split the R
process window in half.  The behavior is controlled by
`split-window-sensibly' with parameters `split-height-threshold'
and `split-width-threshold' replaced by
`ess-watch-height-threshold' and `ess-watch-width-threshold'
respectively."
  (interactive)
  (unless (get-buffer-window ess-watch-buffer 'visible)
    (save-selected-window
      (ess-switch-to-ESS t)
      (let* ((split-width-threshold (or ess-watch-width-threshold
                                        split-width-threshold))
             (split-height-threshold (or ess-watch-height-threshold
                                         split-height-threshold))
             (win (split-window-sensibly (selected-window))))
        (if win
            (set-window-buffer win buffer-or-name)
          (display-buffer buffer-or-name) ;; resort to usual mechanism if could not split
          )))))


(defun ess-watch-revert-buffer (ignore noconfirm)
  "Update the watch buffer
Arguments IGNORE and NOCONFIRM currently not used."
  (ess-watch)
  (message "Watch reverted"))

(defvar ess-watch-mode-map nil
  "Keymap for the *R watch* buffer.

\\{ess-watch-mode-map}
")

(unless ess-watch-mode-map
  (setq ess-watch-mode-map (make-sparse-keymap))
  (when (boundp 'special-mode-map)
    (set-keymap-parent ess-watch-mode-map special-mode-map))
  (define-key ess-watch-mode-map "?" 'ess-watch-help)
  (define-key ess-watch-mode-map "k" 'ess-watch-kill)
  ;; (define-key ess-watch-mode-map "u" 'ess-watch-undelete)
  ;; editing requires a little more work.
  (define-key ess-watch-mode-map "a" 'ess-watch-add)
  (define-key ess-watch-mode-map "i" 'ess-watch-insert)
  (define-key ess-watch-mode-map "e" 'ess-watch-edit-expression)
  (define-key ess-watch-mode-map "r" 'ess-watch-rename)
  (define-key ess-watch-mode-map "q" 'ess-watch-quit)
  (define-key ess-watch-mode-map "u" 'ess-watch-move-up)
  (define-key ess-watch-mode-map "U" 'ess-watch-move-down)
  (define-key ess-watch-mode-map "d" 'ess-watch-move-down)
  (define-key ess-watch-mode-map "n" 'ess-watch-next-block)
  (define-key ess-watch-mode-map "p" 'ess-watch-previous-block)
  ;; R mode keybindings.
  (define-key ess-watch-mode-map "\C-c\C-s" 'ess-watch-switch-process)
  (define-key ess-watch-mode-map "\C-c\C-y" 'ess-switch-to-ESS)
  (define-key ess-watch-mode-map "\C-c\C-z" 'ess-switch-to-end-of-ESS)
  ;; Debug keys:
  )


(defface ess-watch-current-block-face
  '((default (:inherit highlight)))
  "Face used to highlight current watch block."
  :group 'ess-debug)

(defvar  ess-watch-current-block-overlay nil
  "The overlay for currently selected block in the R watch buffer .")
(make-variable-buffer-local 'ess-watch-current-block-overlay)

(defvar ess-watch-buffer "*R watch*"
  "Name of the watch buffer.")

(defvar  ess-watch-start-block "@----"  ;; fixme: make defcustom and modify the injected command correspondingly
  "String indicating the beginning of a block in watch buffer."
  ;; :group 'ess-debug
  ;; :type 'string
  )

(defvar ess-watch-start-expression "@---:"
  "String indicating the beginning of an R expression in watch buffer."
  ;; :group 'ess-debug
  ;; :type 'string
  )

(defcustom ess-watch-height-threshold nil
  "Minimum height for splitting *R* windwow sensibly to make space for watch window.
See `split-height-threshold' for a detailed description.

If nil, the value of `split-height-threshold' is used."
  :group 'ess-debug
  :type 'integer)

(defcustom ess-watch-width-threshold nil
  "Minimum width for splitting *R* windwow sensibly to make space for watch window.
See `split-width-threshold' for a detailed description.

If nil, the value of `split-width-threshold' is used."
  :group 'ess-debug
  :type 'integer)

(defcustom  ess-watch-scale-amount -1
  "The number of steps to scale the watch font down (up).
Each step scales the height of the default face in the watch
window by the variable `text-scale-mode-step' (a negative number
of steps decreases the height by the same amount)")

(defvar ess-watch-help nil
  "Keymap for the *R watch* buffer.

\\{ess-watch-mode-map}
")

(defun ess-watch-help ()
  (interactive)
  (describe-variable 'ess-watch-help))

(defun ess-watch-block-limits-at-point ()
  "Return start and end positions of the watch block."
  (interactive)
  (save-excursion
    (let ((curr (point))
          start-pos end-pos)
      (end-of-line)
      (setq start-pos
            (if (re-search-backward ess-watch-start-block nil t )
                (point)
              (point-min)))
      (goto-char curr)
      (beginning-of-line)
      (setq end-pos
            (if (re-search-forward ess-watch-start-block nil t)
                (match-beginning 0)
              (point-max)))
      (list start-pos end-pos))))

(defun ess-watch-block-at-point ()
  "return the current block's order count, 0 if no block was found."
  (save-excursion
    (let ((cur-point (point))
          (count 0))
      (goto-char (point-min))
      (while (re-search-forward ess-watch-start-block cur-point t)
        (setq count (1+ count)))
      count)))

(defun ess-watch-set-current (nr)
  "Move the overlay over the block with count NR in current watch buffer"
  (goto-char (point-min))
  (re-search-forward ess-watch-start-expression nil t nr)
  (goto-char (match-end 0))
  (apply 'move-overlay ess-watch-current-block-overlay (ess-watch-block-limits-at-point)))


(defun ess-watch--make-alist ()
  "Create an association list of expression from current buffer (better be a watch buffer).
Each element of assoc list is of the form (pos name expr) where
pos is an unique integer identifying watch blocks by position,
name is a string giving the name of expression block, expr is a
string giving the actual R expression."
  (interactive)
  (save-excursion
    (let* ((reg-name (concat "^" ess-watch-start-block " *\\(\\S-*\\).*$"))
           (reg-expr (concat "^" ess-watch-start-expression "\\s-*\\(.*\\)$"))
           (reg-all (concat "\\(" reg-name "\\)\n\\(" reg-expr "\\)"))
           (pos 0) wal name expr)
      (goto-char (point-min))
      (while (re-search-forward reg-all nil t)
        (setq pos  (+ 1 pos))
        (setq name (match-string-no-properties 2))
        (setq expr (match-string-no-properties 4))
        (if (not (eq (string-to-number name) 0))  ;;if number of any kind set the name to ""
            (setq name ""))
        (setq wal
              (append wal (list (list pos name expr)))))
      wal)))

(defun ess-watch--parse-assoc (al)
  "Return a string of the form 'assign(\".ess_watch_expressions\", list(a = parse(expr_a), b= parse(expr_b)), envir = .GlobalEnv)'
ready to be send to R process. AL is an association list as return by `ess-watch--make-alist'"
  (concat ".ess_watch_assign_expressions(list("
          (mapconcat (lambda (el)
                       (if (> (length  (cadr el) ) 0)
                           (concat "`" (cadr el) "` = parse(text = '" (caddr el) "')")
                         (concat "parse(text = '" (caddr el) "')")))
                     al ", ")
          "))\n"))

(defun ess-watch--install-.ess_watch_expressions ()
  ;; used whenever watches are added/deleted/modified from the watch
  ;; buffer. this is the only way  to insert expressions into
  ;; .ess_watch_expressions object in R. Assumes R watch being the current
  ;; buffer, otherwise will most likely install empty list.
  (interactive)
  (process-send-string (ess-get-process ess-current-process-name)
                       (ess-watch--parse-assoc (ess-watch--make-alist)))
  ;;todo: delete the prompt at the end of proc buffer todo: defun ess-send-string!!
  (sleep-for 0.05)  ;; need here, if ess-command is used immediately after,  for some weird reason the process buffer will not be changed
  )


(defun ess-watch-quit ()
  "Quit (kill) the watch buffer.
If watch buffer exists, it is displayed during the debug
process. The only way to avoid the display, is to kill the
buffer."
  (interactive)
  (kill-buffer) ;; dedicated, window is deleted unless not the only one
  )

;;;_  + MOTION
(defun ess-watch-next-block (&optional n)
  "Move the overlay over the next block.
Optional N if supplied gives the number of steps forward backward-char."
  (interactive "P")
  (setq n (prefix-numeric-value n))
  (goto-char (overlay-end ess-watch-current-block-overlay))
  (unless (re-search-forward ess-watch-start-expression nil t n)
    (goto-char (point-min)) ;;circular but always moves to start!
    (re-search-forward ess-watch-start-expression nil t 1))
  (apply 'move-overlay ess-watch-current-block-overlay (ess-watch-block-limits-at-point)))

(defun ess-watch-previous-block (&optional n)
  "Move the overlay over the previous block.
Optional N if supplied gives the number of backward steps."
  (interactive "P")
  (setq n (prefix-numeric-value n))
  (goto-char (overlay-start ess-watch-current-block-overlay))
  (unless (re-search-backward ess-watch-start-expression nil t n)
    (goto-char (point-max)) ;;circular but always moves to last!
    (re-search-backward ess-watch-start-expression nil t 1))
  (goto-char (match-end 0))
  (apply 'move-overlay ess-watch-current-block-overlay (ess-watch-block-limits-at-point)))

;;;_  + BLOCK MANIPULATION and EDITING
(defun ess-watch-rename ()
  "Rename the currently selected watch block. "
  (interactive)
  (end-of-line)
  (unless (re-search-backward ess-watch-start-block nil 1)
    (error "Can not find a watch block"))
  (let ((reg-name (concat ess-watch-start-block " *\\(\\S-*\\).*$"))
        name start end)
    ;; (reg-expr (concat "^" ess-watch-start-expression "\\s-*\\(.*\\)$"))
    ;; (reg-all (concat "\\(" reg-name "\\)\n\\(" reg-expr "\\)"))
    ;; (pos 0) wal name expr)
    (unless (re-search-forward reg-name (point-at-eol) 1)
      (error "Can not find the name substring in the current watch block "))
    (setq name (match-string-no-properties 1))
    (setq start (match-beginning 1))
    (setq end (match-end 1))
    (goto-char start)
    ;; todo: highlight the name in R-watch here
    (setq name (read-string (concat "New name (" name "): ") nil nil name) )
    (setq buffer-read-only nil)
    (delete-region start end)
    (insert name)
    (setq buffer-read-only t)
    (ess-watch--install-.ess_watch_expressions)
    (ess-watch-refresh-buffer-visibly (current-buffer))))

(defun ess-watch-edit-expression ()
  "Edit in the minibuffer the R expression from the current watch block. "
  (interactive)
  (end-of-line)
  (unless (re-search-backward ess-watch-start-block nil 1)
    (error "Can not find a watch block"))
  (let ((reg-expr (concat ess-watch-start-expression " *\\(.*\\)$"))
        expr start end)
    (unless (re-search-forward reg-expr nil 1)
      (error "Can not find an expression string in the watch block"))
    (setq expr (match-string-no-properties 1))
    (setq start (match-beginning 1))
    (setq end (match-end 1))
    (goto-char start)
    ;; todo: highlight the name in R-watch here
    (setq expr (read-string  "New expression: " expr nil expr) )
    (setq buffer-read-only nil)
    (delete-region start end)
    (insert expr)
    (setq buffer-read-only t)
    (ess-watch--install-.ess_watch_expressions)
    (ess-watch-refresh-buffer-visibly (current-buffer))))

(defun ess-watch-add ()
  "Ask for new R expression and name and append it to the end of the list of watch expressions"
  (interactive)
  (let (nr expr name)
    (goto-char (point-max))
    (setq nr (number-to-string (1+ (ess-watch-block-at-point))))
    (setq name nr)
    ;; (setq name (read-string (concat "Name (" nr "):") nil nil nr ))  ;;this one is quite annoying and not really needed than for logging
    (setq expr (read-string "New expression: " nil nil "\"Empty watch!\""))
    (setq buffer-read-only nil)
    (insert (concat "\n" ess-watch-start-block " " name " -@\n" ess-watch-start-expression " " expr "\n"))
    (setq buffer-read-only t)
    (ess-watch--install-.ess_watch_expressions)))

(defun ess-watch-insert ()
  "Ask for new R expression and name and insert it in front of current watch block"
  (interactive)
  (let (nr expr name)
    (setq nr (number-to-string (ess-watch-block-at-point)))
    (setq name nr)
    ;; (setq name (read-string (concat "Name (" nr "):") nil nil nr ))
    (setq expr (read-string "New expression: " nil nil "\"Empty watch!\""))
    (re-search-backward ess-watch-start-block nil 1) ;;point-min if not found
    (setq buffer-read-only nil)
    (insert (concat "\n" ess-watch-start-block " " name " -@\n" ess-watch-start-expression " " expr "\n"))
    (setq buffer-read-only t)
    (ess-watch--install-.ess_watch_expressions)))

(defun ess-watch-move-up ()
  "Move the current block up."
  (interactive)
  (let ((nr (ess-watch-block-at-point))
        wbl)
    (when (> nr 1)
      (setq buffer-read-only nil)
      (setq wbl (apply 'delete-and-extract-region  (ess-watch-block-limits-at-point)))
      (re-search-backward ess-watch-start-block nil t 1) ;; current block was deleted, point is at the end of previous block
      (insert wbl)
      (ess-watch--install-.ess_watch_expressions)
      (setq buffer-read-only t))))


(defun ess-watch-move-down ()
  "Move the current block down."
  (interactive)
  (let ((nr (ess-watch-block-at-point))
        (nr-all (save-excursion (goto-char (point-max))
                                (ess-watch-block-at-point)))
        wbl)
    (when (< nr nr-all)
      (setq buffer-read-only nil)
      (setq wbl (apply 'delete-and-extract-region  (ess-watch-block-limits-at-point)))
      (end-of-line)
      (when (re-search-forward ess-watch-start-block nil 1 1) ;; current block was deleted, point is at the end of previous block or point-max
        (goto-char (match-beginning 0)))
      (insert wbl)
      (ess-watch--install-.ess_watch_expressions)
      (setq buffer-read-only t))))

(defun ess-watch-kill ()
  "Kill the current block"
  (interactive)
  (setq buffer-read-only nil)
  (apply 'delete-region (ess-watch-block-limits-at-point))
  (ess-watch--install-.ess_watch_expressions))

;;;_ + Debug/Undebug at point
(defun ess--dbg-get-signatures (method)
  "Get signatures for the method METHOD"
  (let ((tbuffer (get-buffer-create " *ess-command-output*")); initial space: disable-undo
        signatures curr-point)
    (save-excursion
      (ess-if-verbose-write (format "ess-get-signatures*(%s).. " method))
      (ess-command (concat "showMethods(\"" method "\")\n") tbuffer)
      (message ess-local-process-name)
      (message ess-current-process-name)
      (ess-if-verbose-write " [ok] ..\n")
      (set-buffer tbuffer)
      (goto-char (point-min))
      (if (not (re-search-forward "Function:" nil t))
          (progn (ess-if-verbose-write "not seeing \"Function:\".. \n")
                 (error (buffer-string))
                 ;; (error "Cannot trace  method '%s' (Is it a primitive method which you have already traced?)" method)
                 )
        ;; (setq curr-point (point))
        ;; (while (re-search-forward ", " nil t) ;replace all ", " with  ":" for better redability in completion buffers??
        ;;   (replace-match ":"))
        ;; (goto-char curr-point)
        (while (re-search-forward "^.+$" nil t)
          (setq signatures (cons (match-string-no-properties 0) signatures))))
                                        ;      (kill-buffer tbuffer)
      )
    signatures))


(defun ess-debug-flag-for-debugging ()
  "Set the debugging flag on a function.
Ask the user for a function and if it turns to be generic, ask
for signature and trace it with browser tracer."
  (interactive)
  (ess-force-buffer-current "Process to use: ")
  (let* ((tbuffer (get-buffer-create " *ess-command-output*")) ;; output buffer name is hard-coded in ess-inf.el
         (all-functions (ess-get-words-from-vector
                         (if ess-developer-packages
                             (format ".ess_all_functions(c('%s'))\n"
                                     (mapconcat 'identity ess-developer-packages "', '"))
                           ".ess_all_functions()\n")))
         (obj-at-point (car (ess-helpobjs-at-point all-functions)))
         (ufunc  (ess-completing-read "Debug" all-functions
                                      nil nil nil nil obj-at-point))
         signature default-string out-message)
    ;; is it generic
    (if (equal "TRUE"
               (car (ess-get-words-from-vector
                     (format "as.character(isGeneric('%s'))\n" ufunc))))
        (save-excursion ;; if so, find the signature
          (setq signature
                (ess-completing-read (concat "Method for generic '" ufunc "'")
                                     (ess--dbg-get-signatures ufunc) ;signal an error if not found
                                     nil t nil nil "*default*"))
          (if (equal signature "*default*")
              ;;debug, the default ufunc
              (ess-command (format "trace('%s', tracer = browser)\n" ufunc) tbuffer)
            (ess-command (format "trace('%s', tracer = browser, signature = c('%s'))\n" ufunc signature) tbuffer))
          (set-buffer tbuffer)
          ;; give appropriate message or error
          (setq out-message (buffer-substring-no-properties (point-min) (point-max))))
      ;;else, not an S4 generic
      (when (car (ess-get-words-from-vector
                  (format "as.character(.knownS3Generics['%s'])\n" ufunc)))
        ;; if S3 generic:
        (setq all-functions
              (ess-get-words-from-vector
               (format "local({gens<-methods('%s');as.character(gens[attr(gens, 'info')$visible])})\n" ufunc)))
        (setq all-functions
              ;; cannot debug non-visible methods
              (delq nil (mapcar (lambda (el)
                                  (if (not (char-equal ?* (aref el (1- (length el))))) el))
                                all-functions)))
        ;; tothink: ess-developer?
        (setq ufunc (ess-completing-read (format "Method for S3 generic '%s'" ufunc)
                                         (cons ufunc all-functions) nil t)))
      (save-excursion
        ;; no quotes
        (ess-command (format "debug(%s)\n" ufunc) tbuffer)
        (set-buffer tbuffer)
        (if (= (point-max) 1)
            (setq out-message (format "Flagged function '%s' for debugging" ufunc))
          ;; error occurred
          (setq out-message (buffer-substring-no-properties (point-min) (point-max))))))
    (message out-message)))


(defun ess-debug-unflag-for-debugging ()
  "Prompt for the debugged/traced function or method and undebug/untrace it."
  (interactive)
  (let ((tbuffer (get-buffer-create " *ess-command-output*")); initial space: disable-undo\
        (debugged (ess-get-words-from-vector
                   (if ess-developer-packages
                       (format ".ess_dbg_getTracedAndDebugged(c('%s'))\n"
                               (mapconcat 'identity ess-developer-packages "', '"))
                     ".ess_dbg_getTracedAndDebugged()\n")))
        out-message fun def-val)
    ;; (prin1 debugged)
    (if (eq (length debugged) 0)
        (setq out-message "No debugged or traced functions/methods found")
      (setq def-val (if (eq (length debugged) 1)
                        (car debugged)
                      "*ALL*"))
      (setq fun (ess-completing-read "Undebug" debugged nil t nil nil def-val))
      (if (equal fun "*ALL*" )
          (ess-command (concat ".ess_dbg_UndebugALL(c(\"" (mapconcat 'identity debugged "\", \"") "\"))\n") tbuffer)
        (ess-command (format ".ess_dbg_UntraceOrUndebug(\"%s\")\n" fun) tbuffer))
      (with-current-buffer  tbuffer
        (if (= (point-max) 1) ;; not reliable todo:
            (setq out-message (format  "Undebugged '%s' " fun))
          (setq out-message (buffer-substring-no-properties (point-min) (point-max))) ;; untrace info or warning, or error occurred
          )))
    (message out-message)))

;;;_ * Kludges and Fixes
;;; delete-char and delete-backward-car do not delete whole intangible text
(defadvice delete-char (around ess-delete-backward-char-intangible activate)
  "When about to delete a char that's intangible, delete the whole intangible region
Only do this when #chars is 1"
  (if (and (eq major-mode 'ess-mode)
           (= (ad-get-arg 0) 1)
           (get-text-property (point) 'intangible))
      (progn
        (kill-region (point) (or (next-single-property-change (point) 'intangible)
                                 (point-max)))
        (indent-for-tab-command))
    ad-do-it))

(defadvice delete-backward-char (around ess-delete-backward-char-intangible activate)
  "When about to delete a char that's intangible, delete the whole intangible region
Only do this when called interactively and  #chars is 1"
  (if (and (eq major-mode 'ess-mode)
           (= (ad-get-arg 0) 1)
           (> (point) (point-min))
           (get-text-property (1- (point)) 'intangible))
      (progn
        (let ((beg (or (previous-single-property-change (point) 'intangible)
                       (point-min))))
          (kill-region beg (point))))
    ad-do-it))

;; previous-line gets stuck if next char is intangible
(defadvice previous-line (around ess-fix-cursor-stuck-at-intangible-text activate)
  "When about to move to previous line when next char is
intanbible, step char backward first"
  (if (and (eq major-mode 'ess-mode)
           (or (null (ad-get-arg 0))
               (= (ad-get-arg 0) 1))
           (get-text-property (point) 'intangible))
      (backward-char 1))
  ad-do-it)

;; (ad-remove-advice 'previous-line 'around 'delete-backward-char-intangible)

(make-obsolete-variable 'ess-dbg-blink-ref-not-found-face  'ess-debug-blink-ref-not-found-face "ESS 13.05")
(make-obsolete-variable 'ess-dbg-blink-same-ref-face  'ess-debug-blink-same-ref-face "ESS 13.05")
(make-obsolete-variable 'ess-dbg-current-debug-line-face 'ess-debug-current-debug-line-face "ESS 13.05")
(make-obsolete-variable 'ess-dbg-error-action nil "ESS 13.05")
(make-obsolete-variable 'ess-dbg-error-action-alist 'ess-debug-error-action-alist "ESS 13.05")
(make-obsolete-variable 'ess-dbg-blink-interval 'ess-debug-blink-interval "ESS 13.05")
(make-obsolete-variable 'ess-dbg-indicator 'ess-debug-indicator "ESS 13.05")
(make-obsolete-variable 'ess-dbg-ask-for-file 'ess-debug-ask-for-file "ESS 13.05")
(make-obsolete 'ess-dbg-set-error-action 'ess-debug-set-error-action "ESS 13.05")
(make-obsolete 'ess-dbg-toggle-error-action 'ess-debug-toggle-error-action "ESS 13.05")
(make-obsolete 'ess-dbg-goto-input-event-marker 'ess-debug-goto-input-event-marker "ESS 13.05")
(make-obsolete 'ess-dbg-goto-debug-point 'ess-debug-goto-debug-point "ESS 13.05")
(make-obsolete 'ess-dbg-insert-in-forward-ring 'ess-debug-insert-in-forward-ring "ESS 13.05")
(make-obsolete 'ess-dbg-start 'ess-debug-start "ESS 13.05")
(make-obsolete 'ess-dbg-stop 'ess-debug-stop "ESS 13.05")
(make-obsolete 'ess-dbg-command-digit 'ess-debug-command-digit "ESS 13.05")
(make-obsolete 'ess-dbg-command-n 'ess-debug-command-next "ESS 13.05")
(make-obsolete 'ess-dbg-command-Q 'ess-debug-command-quit "ESS 13.05")
(make-obsolete 'ess-dbg-command-c 'ess-debug-command-continue "ESS 13.05")
(make-obsolete 'ess-dbg-flag-for-debugging 'ess-debug-flag-for-debugging "ESS 13.05")
(make-obsolete 'ess-dbg-unflag-for-debugging 'ess-debug-unflag-for-debugging "ESS 13.05")
(make-obsolete-variable 'ess-tb-last-input-fringe-face 'ess-tracebug-last-input-fringe-face "ESS 13.05")
(make-obsolete-variable 'ess-tb-next-error-function 'ess-tracebug-next-error-function "ESS 13.05")

(ess-if-verbose-write "\n<- debug done")
(provide 'ess-tracebug)

;;; ess-tracebug.el ends here