cgit.sxemacs.org Git - packages/blob - xemacs-packages/jde/lisp/jde-dbs.el

   1 ;;; jde-dbs.el -- JDEbug Session Interface Functions
   2 ;; $Revision: 1.101 $ $Date: 2005/01/18 05:23:31 $
   3
   4 ;; Author: Paul Kinnucan <paulk@mathworks.com>
   5 ;; Maintainer: Paul Kinnucan
   6 ;; Keywords: java, tools
   7
   8 ;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 Paul Kinnucan.
   9
  10 ;; GNU Emacs is free software; you can redistribute it and/or modify
  11 ;; it under the terms of the GNU General Public License as published by
  12 ;; the Free Software Foundation; either version 2, or (at your option)
  13 ;; any later version.
  14
  15 ;; GNU Emacs is distributed in the hope that it will be useful,
  16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18 ;; GNU General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; This is one of a set of packages that make up the
  28 ;; Java Development Environment (JDE) for Emacs. See the
  29 ;; JDE User's Guide for more information.
  30
  31 ;; The latest version of the JDE is available at
  32 ;; <URL:http://sunsite.auc.dk/jde/>.
  33
  34 ;; Please send any comments, bugs, or upgrade requests to
  35 ;; Paul Kinnucan at paulk@mathworks.com.
  36
  37 ;;; Code:
  38
  39 (require 'regress)
  40 (require 'jde-dbo)
  41 (require 'jde-db)
  42 (require 'eieio)
  43 (require 'jde-widgets)
  44 (jde-require 'tree-widget)
  45
  46 ;; Need jde-run only to get the definition for
  47 ;; save-w32-show-window macro.
  48 (eval-when-compile
  49   (require 'jde-run))
  50
  51 (defcustom jde-bug-sio-connect-delay 1
  52   "Length of time in seconds that the JDE waits
  53 before attempting to connect to the
  54 debuggee application's standard I/O. This delay
  55 is intended to give JDEbug time to create the
  56 SIO socket. Try increasing this variable if JDEbug
  57 hangs while launching an application. If your
  58 system never hangs, you can reduce this setting
  59 to 0 to eliminate the connection delay."
  60   :group 'jde-bug
  61   :type 'integer)
  62
  63 (defvar jde-dbs-comint-filter nil
  64   "Standard comint filter for debugger buffer.")
  65
  66 (defvar jde-dbs-debugger-process-name "jdebug"
  67 "Name of debugger process.")
  68
  69 (defun jde-dbs-get-debugger-process ()
  70   (get-process jde-dbs-debugger-process-name))
  71
  72
  73 (defvar jde-dbs-debugger-output-buffer-name "*JDEbug Messages*"
  74 "Name of buffer used to display messages from the debugger.")
  75
  76 (defvar jde-dbs-debugger-socket-process-name "jdebug-socket"
  77 "Name of debugger socket process.")
  78
  79 (defvar jde-dbs-debugger-hook nil
  80   "Hook to run when starting or stopping the debugger.
  81 The hook is run with a single argument which is non-nil when the
  82 debugger is starting and nil when it is quitting.")
  83
  84 (defun jde-dbs-get-debugger-socket-process ()
  85   (get-process jde-dbs-debugger-socket-process-name))
  86
  87 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  88 ;;                                                                            ;;
  89 ;; Process Set                                                                ;;
  90 ;;                                                                            ;;
  91 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  92 (defclass jde-dbs-proc-set ()
  93   ((proc-alist     :initarg :proc-alist
  94                    :type list
  95                    :initform nil
  96                    :documentation
  97                    "List of active debugee processes"))
  98   "Class of debuggee process sets.")
  99
 100 (defmethod jde-dbs-proc-set-add ((this jde-dbs-proc-set) process)
 101   "Adds a process to this debuggee process set."
 102   (oset this :proc-alist
 103         (cons
 104          (cons (oref process :id) process)
 105          (oref this :proc-alist))))
 106
 107 (defmethod jde-dbs-proc-set-remove ((this jde-dbs-proc-set) process)
 108   (oset this :proc-alist
 109         (remove-if
 110          (lambda (assoc-x)
 111            (let* ((xproc (cdr assoc-x))
 112                   (xid (oref xproc id))
 113                   (id (oref process id)))
 114              (equal xid id)))
 115          (oref this proc-alist))))
 116
 117 (defmethod jde-dbs-proc-set-get-proc ((this jde-dbs-proc-set) id)
 118   (cdr (assq id (oref this :proc-alist))))
 119
 120 (defmethod jde-dbs-proc-set-find ((this jde-dbs-proc-set) field value)
 121   "Finds the process in the set whose FIELD is equal to VALUE."
 122   (if (slot-boundp this :proc-alist)
 123       (cdr (find-if
 124         (lambda (assoc-x)
 125           (let ((process-x (cdr assoc-x)))
 126             (equal (eieio-oref process-x field) value)))
 127         (oref this :proc-alist)))))
 128
 129 (defmethod jde-dbs-proc-set-contains-p ((this jde-dbs-proc-set) process)
 130   (assq (oref process :id) (oref this :proc-alist)))
 131
 132 (defmethod jde-dbs-proc-set-get-size ((this jde-dbs-proc-set))
 133   "Gets the number of processes in this set."
 134   (if (slot-boundp this 'proc-alist)
 135       (length (oref this proc-alist))
 136     0))
 137
 138
 139 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 140 ;;                                                                            ;;
 141 ;; Process Registry                                                           ;;
 142 ;;                                                                            ;;
 143 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 144 (defclass jde-dbs-proc-registry (jde-dbs-proc-set)
 145   ((target-process :initarg :target-process
 146                    :type jde-dbs-proc
 147                    :documentation
 148                    "Process that currently has the debugger command focus."))
 149   "Class of process registries.")
 150
 151
 152 (defmethod jde-dbs-proc-registry-set-target-proc ((this jde-dbs-proc-registry) &optional id)
 153   "Sets process specified by ID to be the target process. If ID is not specified, the first
 154 registered process becomes the target process"
 155   (let ((target-process
 156           (if id
 157               (let ((process (jde-dbs-proc-set-get-proc this id)))
 158                 (if process
 159                     (if (jde-dbs-proc-set-contains-p this process)
 160                         process
 161                       (message "Error: process %s is dead." id)
 162                       nil)
 163                   (message "Error: process %s does not exist." id)
 164                   nil))
 165             (let ((existing-processes
 166                    (oref jde-dbs-the-process-registry :proc-alist)))
 167               (if existing-processes (cdr (nth 0 existing-processes)))))))
 168     (when target-process
 169       (oset this target-process target-process)
 170       (set-window-configuration (oref target-process win-cfg)))
 171     target-process))
 172
 173
 174 (defvar jde-dbs-the-process-registry
 175   (jde-dbs-proc-registry "Process Registry")
 176   "The debuggee process registry.")
 177
 178 (defun jde-dbs-get-target-process ()
 179   (and jde-dbs-the-process-registry
 180        (slot-boundp jde-dbs-the-process-registry :target-process)
 181        (oref jde-dbs-the-process-registry :target-process)))
 182
 183
 184 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 185 ;;                                                                            ;;
 186 ;; Process Morgue                                                             ;;
 187 ;;                                                                            ;;
 188 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 189 (defclass jde-dbs-proc-morgue (jde-dbs-proc-set) ()
 190   "Class of process morgues. A process morgue contains dead or dying processes.
 191 Their carcasses must be kept around until the debugger stops sending messages
 192 concerning them." )
 193
 194 (defmethod jde-dbs-proc-morgue-bury-the-dead ((this jde-dbs-proc-morgue))
 195   (mapc
 196    (lambda (dead-proc-assoc)
 197      (let* ((dead-proc (cdr dead-proc-assoc))
 198             (cli-buffer (if (slot-boundp dead-proc 'cli-buf) (oref dead-proc cli-buf)))
 199             (msg-buffer (if (slot-boundp dead-proc 'msg-buf) (oref dead-proc msg-buf)))
 200             (locals-buffer (if (slot-boundp dead-proc 'locals-buf) (oref dead-proc locals-buf)))
 201             (threads-buffer (if (slot-boundp dead-proc 'threads-buf) (oref dead-proc threads-buf))))
 202        (if cli-buffer (kill-buffer cli-buffer))
 203        (if msg-buffer (kill-buffer msg-buffer))
 204        (if locals-buffer (kill-buffer locals-buffer))
 205        (if threads-buffer (kill-buffer threads-buffer))))
 206    (oref this proc-alist))
 207   (oset this proc-alist nil))
 208
 209
 210 (defvar jde-dbs-the-process-morgue
 211   (jde-dbs-proc-morgue "Process Morgue")
 212   "The JDE process morgue. This morgue contains processes that are dead or
 213 dying, for example, because they have been terminated by the user or the
 214 debugger. Their corpses must be kept around until it is clear they are dead and
 215 the debugger ceases sending messages concerning them.")
 216
 217
 218 (defun jde-dbs-get-process (id)
 219 "Get the process whose id is ID. This function looks first in the process registry
 220 and then in the process morgue for the process."
 221   (let ((process
 222          (jde-dbs-proc-set-get-proc jde-dbs-the-process-registry id)))
 223     (if (not process)
 224         (setq process (jde-dbs-proc-set-get-proc jde-dbs-the-process-morgue id)))
 225     process))
 226
 227
 228
 229 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 230 ;;                                                                            ;;
 231 ;; Process State Info                                                         ;;
 232 ;;                                                                            ;;
 233 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 234 (defclass jde-dbs-proc-state-info ()
 235   ((state       :initarg :state)
 236    (reason      :initarg :reason)
 237    (thread-id   :initarg :thread-id)
 238    (thread-name :initarg :thread-name))
 239   "Class of process state information objects.")
 240
 241
 242 (defmethod jde-dbs-proc-state-info-set ((this jde-dbs-proc-state-info)
 243                                         state reason thread-id thread-name)
 244   (oset this reason reason)
 245   (oset this state state)
 246   (oset this thread-id thread-id)
 247   (oset this thread-name thread-name))
 248
 249
 250
 251 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 252 ;;                                                                            ;;
 253 ;; Breakpoint Specification                                                   ;;
 254 ;;                                                                            ;;
 255 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 256 (defclass jde-dbs-proc-bpspec ()
 257   ((id         :initarg :id
 258                :type integer
 259                :documentation
 260                "Id assigned to this breakpoint by the debugger.")
 261    (breakpoint :initarg :breakpoint
 262                :type jde-db-breakpoint
 263                :documentation
 264                "Instance of `jde-db-breakpoint'.")
 265    (resolved   :initarg :resolved))
 266   (:allow-nil-initform t)
 267   "Class of breakpoint specifications. A breakpoint specification contains
 268 process-specific information about a breakpoint")
 269
 270
 271 ;; Defines a class of containers for breakpoint specs.
 272 ;; Each container lists the process specs for breakpoints set in a
 273 ;; particular process.
 274
 275 (defun jde-dbs-proc-bpspecs-add (bpspecs bpspec)
 276   "Adds BPSPEC to BPSPECS, a process's breakpoint spec list."
 277   (cons
 278    (cons (oref bpspec id) bpspec)
 279    bpspecs))
 280
 281 (defun jde-dbs-proc-bpspecs-remove (bpspecs bpspec)
 282   "Removes BPSPEC from BPSPECS"
 283   (remove-if (lambda (x)
 284                (equal (car x) (oref bpspec id) ))
 285              bpspecs))
 286
 287 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 288 ;;                                                                            ;;
 289 ;; Trace Request Class                                                        ;;
 290 ;;                                                                            ;;
 291 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 292 (defclass jde-dbs-trace-request ()
 293   ((id                  :initarg :id
 294                         :type integer
 295                         :documentation
 296                         "Trace request id")
 297    (suspend-policy      :initarg :suspend-policy
 298                         :type string
 299                         :initform "none"
 300                         :documentation
 301                         "Valid values are all (all threads), thread (current thread), or none")
 302    (inclusion-filters   :initarg :inclusion-filters
 303                         :type list
 304                         :documentation
 305                         "List of regular expressions specifying classes to include in trace.")
 306    (exclusion-filters   :initarg :exclusion-filters
 307                         :type list
 308                         :documentation
 309                         "List of regular expressions specifying classes to exclude from trace.")
 310    (cancel-command      :initarg :cancel-command
 311                         :type string
 312                         :documentation
 313                         "Name of command used to cancel this request.")
 314    )
 315 "Super class of trace requests."
 316 )
 317
 318
 319 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 320 ;;                                                                            ;;
 321 ;; Trace Method Request Class                                                 ;;
 322 ;;                                                                            ;;
 323 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 324 (defclass jde-dbs-trace-methods-request (jde-dbs-trace-request)
 325    ((trace-type         :initarg :trace-type
 326                         :type string
 327                         :initform "entry"
 328                         :documentation
 329                         "Entry or exit.")
 330    (thread-restriction  :initarg :thread-restriction
 331                         :type string
 332                         :documentation
 333                         "Thread to trace."))
 334    "Trace methods request."
 335 )
 336
 337 (defmethod initialize-instance ((this jde-dbs-trace-methods-request) &rest fields)
 338   "Constructor for objects of `jde-dbs-trace-methods-request' class."
 339   (call-next-method)
 340   (oset this cancel-command "cancel_trace_methods"))
 341
 342
 343 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 344 ;;                                                                            ;;
 345 ;; Trace Classes Request Class                                                ;;
 346 ;;                                                                            ;;
 347 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 348 (defclass jde-dbs-trace-classes-request (jde-dbs-trace-request)
 349    ((trace-type         :initarg :trace-type
 350                         :type string
 351                         :initform "preparation"
 352                         :documentation
 353                         "Valid values are preparation or unloading."))
 354    "Trace classes request."
 355 )
 356
 357 (defmethod initialize-instance ((this jde-dbs-trace-classes-request) &rest fields)
 358   "Constructor for objects of `jde-dbs-trace-classes-request' class."
 359   (call-next-method)
 360   (oset this cancel-command "cancel_trace_classes"))
 361
 362
 363 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 364 ;;                                                                            ;;
 365 ;; Trace Exceptions Request Class                                             ;;
 366 ;;                                                                            ;;
 367 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 368 (defclass jde-dbs-trace-exceptions-request (jde-dbs-trace-request)
 369   ((exception-class    :initarg :exception-class
 370                        :type string
 371                        :documentation
 372                        "Class of exceptions to trace. Can be a wild card pattern.")
 373    (trace-type         :initarg :trace-type
 374                        :type string
 375                        :initform "both"
 376                        :documentation
 377                         "Valid values are caught, uncaught, or both."))
 378    "Trace exceptions request."
 379 )
 380
 381 (defmethod initialize-instance ((this jde-dbs-trace-exceptions-request) &rest fields)
 382   "Constructor for objects of `jde-dbs-trace-exceptions-request' class."
 383   (call-next-method)
 384   (oset this cancel-command "clear"))
 385
 386
 387 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 388 ;;                                                                            ;;
 389 ;; Watch Field Request Class                                                  ;;
 390 ;;                                                                            ;;
 391 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 392 (defclass jde-dbs-watch-field-request (jde-dbs-trace-request)
 393   ((watch-type         :initarg :watch-type
 394                        :type string
 395                        :documentation
 396                        "Valid values are \"access\" and \"modification\".")
 397    (object-class       :initarg :object-class
 398                        :type string
 399                        :documentation
 400                        "Class of object to watch. Can be a wild card pattern.")
 401    (field-name         :initarg :field-name
 402                        :type string
 403                        :documentation
 404                         "Name of field to watch.")
 405    (expression         :initarg :expression
 406                        :type string
 407                        :documentation
 408                        "Boolean expression that must be satisfied to suspend execution.")
 409    (object-id          :initarg :object-id
 410                        :type string
 411                        :documentation
 412                        "Id of object to watch."))
 413    "Watch field request."
 414 )
 415
 416
 417
 418 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 419 ;;                                                                            ;;
 420 ;; Debuggee Process Status                                                    ;;
 421 ;;                                                                            ;;
 422 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 423 (defclass jde-dbs-proc-status (jde-db-debuggee-status)
 424    ((startup-p     :initarg :startupp
 425                   :type boolean
 426                   :initform nil
 427                   :documentation
 428                   "Non-nil if this process is in the startup state.")
 429     (steppable-p  :initarg :steppablep
 430                   :type boolean
 431                   :initform nil
 432                   :documentation
 433                   "Non-nil if this process can be single-stepped."))
 434   "Status of process being debugged with JDEbug.")
 435
 436 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 437 ;;                                                                            ;;
 438 ;; Debuggee Process Class                                                     ;;
 439 ;;                                                                            ;;
 440 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 441 (defclass jde-dbs-proc (jde-db-debuggee-app)
 442   ((id            :initarg :id
 443                   :type integer
 444                   :documentation
 445                   "Id assigned by the JDE.")
 446    (cli-socket    :initarg :cli-socket
 447                   :type integer
 448                   :documentation
 449                   "Number of socket used by the process's command line interface.")
 450    (cli-buf       :initarg :cli-buf
 451                   :type buffer
 452                   :documentation
 453                   "Buffer for the process's command-line interface.")
 454    (msg-buf       :initarg :msf-buf
 455                   :type buffer
 456                   :documentation
 457                   "Buffer used to display debugger output for this process")
 458    (threads-buf   :initarg :threads-buf
 459                   :type buffer
 460                   :documentation
 461                   "Buffer used to display threads.")
 462    (locals-buf    :initarg :locals-buf
 463                   :type buffer
 464                   :documentation
 465                   "Buffer used to display local variables.")
 466    (startupp       :initarg :startupp
 467                   :type boolean
 468                   :initform nil
 469                   :documentation
 470                   "non-nil if this process is in the startup state.")
 471    (suspendedp    :initarg :suspendedp
 472                   :type boolean
 473                   :initform nil
 474                   :documentation
 475                   "non-nil if this process has been suspended by the debugger.")
 476    (steppablep    :initarg :steppablep
 477                   :type boolean
 478                   :initform nil
 479                   :documentation
 480                   "non-nil if this process can be single-stepped.")
 481    (state-info    :initarg :state-info
 482                   :type jde-dbs-proc-state-info
 483                   :documentation
 484                   "Process state information.")
 485    (stack         :initarg :stack
 486                   :type list
 487                   :documentation
 488                   "Lists stack frames for thread of current step or breakpoint.")
 489    (stack-ptr     :initarg :stack-ptr
 490                   :type integer
 491                   :initform 0
 492                   :documentation
 493                   "Points to the current frame on the stack.")
 494    (trace-req     :initarg :trace-req
 495                   :type list
 496                   :documentation
 497                   "List of outstanding trace requests.")
 498    (watch-req     :initarg :watch-req
 499                   :type list
 500                   :documentation
 501                   "List of outstanding watch field requests.")
 502    (object-refs   :initarg :object-refs
 503                   :type list
 504                   :initform nil
 505                   :documentation
 506                   "IDs of debuggee objects currently referenced by the debugger.")
 507    (bpspecs       :initarg :bpspecs
 508                   :type list
 509                   :documentation
 510                   "Breakpoints set in this process.")
 511    (last-cmd      :initarg :last-cmd
 512                   :type jde-dbs-cmd
 513                   :documentation
 514                   "Most recent command targeting this process.")
 515    (win-cfg       :initarg :win-cfg
 516                   :type window-configuration
 517                   :documentation
 518                   "Desired window configuration for this process.")
 519    (attachedp     :initarg :attachedp
 520                   :type boolean
 521                   :initform nil
 522                   :documentation
 523                   "Non-nil if the debugger was attached to this process."))
 524   (:allow-nil-initform t)
 525   "Class of debuggee processes.")
 526
 527 (defmethod initialize-instance ((this jde-dbs-proc) &rest fields)
 528   "Constructor for objects of `jde-dbs-proc' class."
 529   (call-next-method)
 530
 531   (if (not (slot-boundp this 'state-info))
 532       (oset this state-info
 533             (jde-dbs-proc-state-info
 534              (format "State Info %d" (oref this id)))))
 535
 536   (assert (slot-boundp this 'main-class))
 537   (assert (slot-boundp this 'id))
 538
 539   (oset this msg-buf (get-buffer-create
 540                       (format "*Process %s(%d)*"
 541                               (oref this main-class)
 542                               (oref this id))))
 543   (save-excursion
 544     (set-buffer (oref this msg-buf))
 545     (erase-buffer)
 546     (goto-char (point-min))
 547     (insert
 548        (format "*** Debugger Output for Process %s(%d) ***\n\n"
 549                (oref this main-class)
 550                (oref this id))))
 551
 552   (oset this locals-buf (get-buffer-create
 553                          (format "*%s(%d) Local Variables*"
 554                                  (oref this main-class)
 555                                  (oref this id))))
 556
 557   (oset this threads-buf (get-buffer-create
 558                           (format "*%s(%d) Threads*"
 559                                   (oref this main-class)
 560                                   (oref this id)))))
 561
 562
 563 (defmethod jde-dbs-proc-set-state ((this jde-dbs-proc) state)
 564   (let ((state-info (oref this state-info)))
 565     (oset state-info state state)))
 566
 567 (defmethod jde-dbs-proc-set-state-reason ((this jde-dbs-proc) reason)
 568   (let ((state-info (oref this state-info)))
 569     (oset state-info reason reason)))
 570
 571 (defmethod jde-dbs-proc-get-state ((this jde-dbs-proc))
 572   (oref (oref this state-info) state))
 573
 574 (defmethod jde-dbs-proc-get-state-reason ((this jde-dbs-proc))
 575   (oref (oref this state-info) reason))
 576
 577 (defmethod jde-dbs-proc-display-debug-message ((this jde-dbs-proc)
 578                                                message
 579                                                &optional pop-buffer)
 580   (let ((buffer
 581          (oref this msg-buf)))
 582     (if buffer
 583         (save-excursion
 584           (let ((source-window (selected-window))
 585                 (currbuffp (equal buffer (current-buffer)))
 586                 win)
 587             (if (not currbuffp) (other-window -1))
 588             (set-buffer buffer)
 589             (goto-char (point-max))
 590             (insert (concat message "\n"))
 591             (goto-char (point-max))
 592             (if (not currbuffp) (other-window 1))
 593             (if (and pop-buffer (one-window-p))
 594                 (progn
 595                   (setq win (split-window source-window))
 596                   (set-window-buffer win buffer)))
 597             (if pop-buffer
 598                 (progn
 599                   (set-window-buffer (next-window source-window) buffer)
 600                   (select-window source-window))
 601               (if (not currbuffp)
 602                   (message message))))))))
 603
 604 (defmethod jde-dbs-proc-move-to-morgue ((this jde-dbs-proc))
 605   "Moves this process from the process registry to the process morgue."
 606   (jde-dbs-proc-set-remove jde-dbs-the-process-registry this)
 607   (jde-dbs-proc-set-add jde-dbs-the-process-morgue this))
 608
 609 (defmethod jde-dbs-proc-move-to-registry ((this jde-dbs-proc))
 610   "Moves this process from the registry to the morgue."
 611   (jde-dbs-proc-set-remove jde-dbs-the-process-morgue this)
 612   (jde-dbs-proc-set-add jde-dbs-the-process-registry this))
 613
 614
 615 (defmethod jde-dbs-proc-get-bpspec ((this jde-dbs-proc) bp)
 616   "Gets the process specification for a breakpoint. BP may be either
 617 an instance of `jde-db-breakpoint' or the debugger-assigned id
 618 for the breakpoint."
 619   (if (slot-boundp this 'bpspecs)
 620       (let ((bpspecs (oref this bpspecs)))
 621         (if (and (object-p bp) (jde-db-breakpoint-p bp))
 622             (let* ((jde-id (oref bp id)))
 623               (cdr
 624                (find-if
 625                 (lambda (assoc-x)
 626                   (let ((spec (cdr assoc-x)))
 627                     (equal (oref (oref spec breakpoint) id) jde-id)))
 628                 bpspecs)))
 629           (cdr (assoc bp bpspecs))))))
 630
 631 (defmethod jde-dbs-proc-runnable-p ((this jde-dbs-proc))
 632   (or
 633    (oref this startupp)
 634    (oref this suspendedp)
 635    (oref this steppablep)))
 636
 637 (defun jde-dbs-target-process-runnable-p ()
 638   (interactive)
 639   (let ((target (jde-dbs-get-target-process)))
 640     (and target (jde-dbs-proc-runnable-p target))))
 641
 642 (defun jde-dbs-target-process-steppable-p ()
 643   (interactive)
 644   (let ((target (jde-dbs-get-target-process)))
 645     (and target (oref target steppablep))))
 646
 647 (defun jde-dbs-display-debug-message (proc-id message)
 648   (let ((process (jde-dbs-get-process proc-id)))
 649     (if process
 650         (jde-dbs-proc-display-debug-message process message)
 651       (message message))))
 652
 653 (defvar jde-dbs-proc-counter 0
 654   "Process counter. Used to generate process IDs.")
 655
 656
 657 (eval-when-compile
 658   ;; This code will not appear in the compiled (.elc) file
 659   (put 'test-jde-dbs-proc 'regression-suite t)
 660   (setq test-jde-dbs-proc
 661    '("test-jde-dbs-proc"
 662      ;; Each test in the suite is of the form:
 663      ;;   ([description] probe grader)
 664      ;;   DESCRIPTION - string
 665      ;;   PROBE -  a sexp which runs the actual test
 666      ;;   GRADER - the desired result or a sexp which determines
 667      ;;   how we did
 668      ("Test creation of a jde-dbs-proc instance"
 669       (jde-dbs-proc
 670        (format "process%d" 100) :id 100 :main-class "jmath.Test")
 671       :test t)
 672      )))
 673
 674
 675 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 676 ;;                                                                            ;;
 677 ;; Java Object                                                                ;;
 678 ;;                                                                            ;;
 679 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 680 (defclass jde-dbs-java-obj ()
 681   ((jtype  :initarg :jtype
 682            :type string
 683            :documentation
 684           "Type of this object."))
 685   "Superclass of Java objects.")
 686
 687 (defmethod jde-dbs-java-obj-to-string ((this jde-dbs-java-obj))
 688   "")
 689
 690
 691 (defclass jde-dbs-java-primitive (jde-dbs-java-obj)
 692   ((value :initarg :value
 693           :type (or string number)
 694           :documentation
 695           "Value of this primitive object."))
 696   "Class of Java primitives.")
 697
 698 (defmethod jde-dbs-java-obj-to-string ((this jde-dbs-java-primitive))
 699   (format "%s" (oref this value)))
 700
 701 (defclass jde-dbs-java-null (jde-dbs-java-obj) ()
 702   "Java null object.")
 703
 704 (defmethod initialize-instance ((this jde-dbs-java-null) &rest fields)
 705   "Constructor for run process command."
 706
 707   ;; Call parent initializer.
 708   (call-next-method)
 709
 710   (oset this jtype "null"))
 711
 712
 713 (defmethod jde-dbs-java-obj-to-string ((this jde-dbs-java-null))
 714   "null")
 715
 716
 717 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 718 ;;                                                                            ;;
 719 ;; Java Variable                                                              ;;
 720 ;;                                                                            ;;
 721 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 722 (defclass jde-dbs-java-variable ()
 723   ((name         :initarg :name
 724                  :type string
 725                  :documentation
 726                  "Name of this variable")
 727    (jtype        :initarg :jtype
 728                  :type string
 729                  :documentation
 730                  "Type of this variable.")
 731    (value        :initarg :value
 732                  :type jde-dbs-java-obj
 733                  :documentation
 734                  "Value of this variable."))
 735   "Class that defines the JDE's representation of a Java variable.")
 736
 737 (defmethod jde-dbs-java-variable-to-string ((this jde-dbs-java-variable))
 738   (format "%s %s = %s"
 739           (oref this jtype)
 740           (oref this name)
 741           (jde-dbs-java-obj-to-string (oref this value))))
 742
 743
 744 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 745 ;;                                                                            ;;
 746 ;; Java Class Instance                                                        ;;
 747 ;;                                                                            ;;
 748 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 749 (defclass jde-dbs-java-class-instance (jde-dbs-java-obj)
 750   ((id           :initarg :id
 751                  :type integer
 752                  :documentation
 753                  "Id assigned to this object by the debugger.")
 754    (gc-flag      :initarg :gc-flag
 755                  :type boolean
 756                  :documentation
 757                  "t if this object has been garbage collected."))
 758   "Instance of a Java class accessed via the debugger.")
 759
 760
 761 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 762 ;;                                                                            ;;
 763 ;; Java Array                                                                 ;;
 764 ;;                                                                            ;;
 765 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 766 (defclass jde-dbs-java-array (jde-dbs-java-class-instance)
 767   ((length     :initarg :length
 768                :type integer
 769                :documentation
 770                "Length of this array.")
 771    (elements   :initarg :elements
 772                :type list
 773                :initform nil
 774                :documentation
 775                "Elements of this array."))
 776   "Class of Lisp objects representing instances of Java arrays.")
 777
 778
 779
 780 (defmethod jde-dbs-java-obj-to-string ((this jde-dbs-java-array))
 781   (let ((str (format "<%s:%d%s> %d"
 782                      (if (slot-boundp this :jtype)
 783                          (oref this jtype))
 784                      (if (slot-boundp this :id)
 785                          (oref this id))
 786                      (if (slot-boundp this :gc-flag)
 787                          (if (oref this gc-flag) ":gc" ""))
 788                      (if (slot-boundp this :length)
 789                          (oref this length)
 790                        0)))
 791         (elements (if (slot-boundp this :elements)
 792                       (oref this elements))))
 793     (if elements
 794         (let ((sep "\n |- "))
 795           (concat
 796            str
 797            sep
 798            (mapconcat
 799             (lambda (element)
 800               (jde-dbs-java-obj-to-string element))
 801             elements sep)))
 802       str)))
 803
 804
 805
 806 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 807 ;;                                                                            ;;
 808 ;; Java User-Defined Class Instance                                           ;;
 809 ;;                                                                            ;;
 810 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 811 (defclass jde-dbs-java-udci (jde-dbs-java-class-instance)
 812   ((fields       :initarg :fields
 813                  :type list
 814                  :initform nil
 815                  :documentation
 816                  "Fields of this object."))
 817   "Class of Lisp objects representing instances of user-defined Java classes.")
 818
 819
 820 (defmethod jde-dbs-java-udci-add-field ((this jde-dbs-java-udci) field)
 821   (oset this fields
 822         (nconc (oref this fields) (list (cons (oref field name) field)))))
 823
 824
 825 (defmethod jde-dbs-java-obj-to-string ((this jde-dbs-java-udci))
 826   (let ((str (format "<%s:%d%s>"
 827                      (oref this jtype)
 828                      (oref this id)
 829                      (if (oref this gc-flag) ":gc" "")))
 830         (fields (oref this fields)))
 831     (if fields
 832         (let ((sep "\n |- "))
 833           (concat
 834            str
 835            sep
 836            (mapconcat
 837             (lambda (assoc-x)
 838               (jde-dbs-java-variable-to-string (cdr assoc-x)))
 839             fields sep)))
 840       str)))
 841
 842
 843 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 844 ;;                                                                            ;;
 845 ;; Debugger Class                                                             ;;
 846 ;;                                                                            ;;
 847 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 848 (defclass jde-dbs-debugger (jde-db-debugger)
 849   ((comint-filter :initarg :comint-filter)
 850    (started-p     :initarg :started-p
 851                   :initform nil
 852                   :type boolean
 853                   :documentation
 854                   "True if debugger started successfully."))
 855   "Class of JDEbug debuggers.")
 856
 857 (defmethod initialize-instance ((this jde-dbs-debugger) &rest fields)
 858   "Constructor for JDEbug."
 859   (oset this :name "JDEbug")
 860   (oset this :buffer-name "*JDEbug*"))
 861
 862
 863 (defmethod jde-dbs-debugger-register-process-filter ((debugger jde-dbs-debugger) filter)
 864   "Set the process filter for the debugger to FILTER."
 865   (set-process-filter  (oref debugger process) filter))
 866
 867
 868 (defmethod jde-dbs-debugger-display-message ((debugger jde-dbs-debugger) message)
 869   "Displays message in the debugger process buffer."
 870  (let ((buffer
 871          (oref debugger buffer)))
 872     (if buffer
 873         (save-excursion
 874           (set-buffer buffer)
 875           (goto-char (process-mark (get-buffer-process buffer)))
 876           (insert-before-markers (concat message "\n"))))))
 877
 878 (defmethod jde-dbs-debugger-start ((this jde-dbs-debugger))
 879   "Starts the debugger."
 880   (if (jde-dbs-debugger-running-p)
 881       (progn
 882         (message "An instance of the debugger is running.")
 883         (pop-to-buffer (jde-dbs-get-app-buffer-name))
 884         nil)
 885     (let* ((debugger-buffer-name
 886               (oref this buffer-name))
 887              (debugger-buffer
 888               (let ((old-buf (get-buffer debugger-buffer-name)))
 889                     (if old-buf (kill-buffer old-buf))
 890                     (get-buffer-create debugger-buffer-name)))
 891              (win32-p (eq system-type 'windows-nt))
 892              (w32-quote-process-args ?\")
 893              (win32-quote-process-args ?\") ;; XEmacs
 894              (source-directory default-directory)
 895              (working-directory
 896               (if (and
 897                    jde-run-working-directory
 898                    (not (string= jde-run-working-directory "")))
 899                   (jde-normalize-path 'jde-run-working-directory)
 900                 source-directory))
 901              (vm (oref (jde-run-get-vm) :path))
 902              (jde-java-directory
 903               (expand-file-name "java"
 904                (jde-find-jde-data-directory)))
 905              (vm-args
 906                 (let (args)
 907                   (setq args
 908                         (append
 909                          args
 910                          (list
 911                           "-classpath"
 912                           (jde-build-classpath
 913                                (list
 914                                  (expand-file-name
 915                                   (if jde-bug-debug "classes" "lib/jde.jar")
 916                                   jde-java-directory)
 917                                  (if (jde-bug-vm-includes-jpda-p)
 918                                    (jde-get-tools-jar)
 919                                    (expand-file-name
 920                                     "lib/jpda.jar" (jde-normalize-path
 921                                                     'jde-bug-jpda-directory))))))))
 922                   (if jde-bug-debug
 923                       (setq args
 924                             (append args
 925                              (list "-Xdebug"
 926                                    "-Xnoagent"
 927                                    "-Xrunjdwp:transport=dt_socket,address=2112,server=y,suspend=n"))))
 928                   (setq args (append args (list "jde.debugger.Main")))
 929                   args))
 930              (command-string
 931               (concat
 932                vm " "
 933                (jde-run-make-arg-string
 934                 vm-args)
 935                "\n\n"))
 936              debugger-process)
 937         (run-hook-with-args 'jde-dbs-debugger-hook t)
 938         (oset this started-p nil)
 939         (setq jde-dbs-debugger-output nil)
 940
 941
 942         (save-excursion
 943           (set-buffer debugger-buffer)
 944           (erase-buffer)
 945           ;; Set working directory
 946           (if (and
 947                (file-exists-p working-directory)
 948                (file-directory-p working-directory))
 949               (cd working-directory)
 950             (error "Invalid working directory: %s" working-directory))
 951           (insert (concat "cd " working-directory "\n"))
 952           (insert command-string)
 953           (jde-run-mode))
 954
 955         (save-w32-show-window
 956          (comint-exec debugger-buffer debugger-buffer-name vm nil vm-args)
 957          (setq debugger-process (get-process debugger-buffer-name))
 958          (oset this process debugger-process)
 959          (oset this buffer debugger-buffer)
 960          (oset this comint-filter (process-filter debugger-process))
 961          (jde-dbs-debugger-register-process-filter this 'jde-dbs-asynch-output-listener)
 962          )
 963
 964         (cd source-directory)
 965
 966         (bury-buffer debugger-buffer)
 967
 968         (setq jde-dbs-proc-counter 0)
 969
 970         (setq jde-dbs-cmd-counter 0)
 971
 972         ;; Wait for response from debugger
 973         (if (not (accept-process-output debugger-process jde-bug-debugger-command-timeout 0))
 974             (progn
 975               (message "Error: debugger failed to start.")
 976               nil)
 977           (oref this started-p))
 978
 979         ;; Create a process registry for registering debuggee processes
 980         ;; started by the debugger.
 981         (setq jde-dbs-the-process-registry
 982               (jde-dbs-proc-registry "Process Registry"))
 983
 984         ;; Create a registry for debuggee processes that have died but
 985         ;; still may be getting messages from the debugger.
 986         (setq jde-dbs-the-process-morgue
 987               (jde-dbs-proc-morgue "Process Morgue")))))
 988
 989
 990
 991
 992 (defmethod jde-dbs-debugger-quit ((debugger jde-dbs-debugger))
 993   (jde-dbs-do-command -1 "quit")
 994   (run-hook-with-args 'jde-dbs-debugger-hook nil)
 995   (slot-makeunbound debugger :process)
 996   (slot-makeunbound debugger :buffer)
 997   (slot-makeunbound debugger :comint-filter))
 998
 999 (defun jde-dbs-debugger-running-p ()
1000   "*Returns t if the debugger is running."
1001   (and (slot-boundp jde-dbs-the-debugger 'buffer)
1002        (oref jde-dbs-the-debugger started-p)
1003        (comint-check-proc (oref jde-dbs-the-debugger buffer))))
1004
1005 (defmethod jde-db-debugger-launch ((this jde-dbs-debugger) main-class)
1006   "Launch the application whose main class is MAIN-CLASS in debug mode."
1007   )
1008
1009 (defvar jde-dbs-the-debugger (jde-dbs-debugger "JDEbug")
1010   "The debugger.")
1011
1012 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1013 ;;                                                                            ;;
1014 ;; JDEbug Command Line Commands                                               ;;
1015 ;;                                                                            ;;
1016 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1017 (defclass jde-dbs-cmd (jde-db-cmd)
1018   ((process    :initarg :process
1019                :type jde-dbs-proc
1020                :documentation
1021                "Process that this command targets.")
1022    (id         :initarg :id
1023                :type integer
1024                :documentation
1025                "Command id.")
1026    (name       :initarg :name
1027                :type string
1028                :documentation
1029                "Name of command.")
1030    (result     :initarg :result
1031                :documentation
1032                "Result of executing command.")
1033    (data       :initarg :data
1034                :documentation
1035                "Data returned by command.")
1036    (msg        :initarg :msg
1037                :type string
1038                :documentation
1039                "Message to display to user in debug buffer.")
1040    )
1041   "Super class of debugger commands.")
1042
1043
1044 (defmethod initialize-instance ((this jde-dbs-cmd) &rest fields)
1045   "Constructor for debugger commands. Generates a unique id for this command."
1046   (call-next-method)
1047   (setq jde-dbs-cmd-counter (+ jde-dbs-cmd-counter 1))
1048   (oset this id jde-dbs-cmd-counter))
1049
1050 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-cmd))
1051   "Creates the command line for this command by concatentating
1052 the process id, command id, and command name. If there is no
1053 process, specifies the process id as -1. Derived classes can
1054 extend this method to specify command arguments."
1055   (let* ((process (oref this process))
1056          (process-id (if process (oref process id) -1))
1057          (command-id (oref this id))
1058          (command-name (oref this name)))
1059     (format "%s %s %s" process-id command-id command-name)))
1060
1061 (defvar jde-dbs-debugger-output nil
1062   "Contains output from the debugger.")
1063
1064 (defvar jde-dbs-command-reply nil
1065   "Contains reply to a debugger command.")
1066
1067 (defvar jde-dbs-pending-command 0
1068 "Number of the current command.")
1069
1070 (defun jde-dbs-eval-debugger-output (lisp-form)
1071   (condition-case error-desc
1072       (eval (read lisp-form))
1073     (error
1074      (let* ((process (jde-dbs-get-target-process)))
1075        (if process
1076            (jde-dbs-proc-display-debug-message
1077             process
1078             (concat
1079              "Error: evaluating debugger output caused a Lisp error.\n"
1080              "  See *messages* buffer for details.")))
1081        (message "Error: evaluating output from the debugger caused a Lisp error.")
1082        (message "Debugger output: %s." lisp-form)
1083        (message "Lisp error: %s" error-desc)))))
1084
1085 (defun jde-dbs-extract-exception (debugger-output)
1086   (let ((lisp-form "")
1087         (remainder "")
1088         (output-length (length debugger-output))
1089         (re "\\(.*Exception:.*[\n]\\)+\\(.*at[^\n]*[\n]\\)+"))
1090     (if (string-match re debugger-output)
1091         (let ((start (match-beginning 0))
1092               (end (match-end 0)))
1093           (setq lisp-form (format "(jde-dbo-unknown-exception \"%s\")"
1094                                   (substring debugger-output 0 end)))
1095           (if (< end output-length)
1096               (setq remainder (substring debugger-output end output-length))))
1097       (setq remainder debugger-output))
1098     (cons lisp-form remainder)))
1099
1100 (defun jde-dbs-extract-lisp-form (debugger-output)
1101 "Extract first complete Lisp form from debugger output.
1102 Returns (FORM . REMAINDER) where FORM is the Lisp form
1103 or the null string and REMAINDER is the remainder of the
1104 debugger output following the Lisp form."
1105   (let ((lisp-form "")
1106         (remainder "")
1107         (level 0)
1108         in-string-p
1109         in-escape-p
1110         (curr-pos 1)
1111         (output-length (length debugger-output))
1112         command-end
1113         lisp-form-end)
1114     (setq
1115      lisp-form-end
1116      (catch 'found-lisp-form
1117        ;; skip over any inital white space.
1118        (string-match "^[\n\t ]*(" debugger-output)
1119        (setq curr-pos (match-end 0))
1120
1121        (while (< curr-pos output-length)
1122
1123          (cond
1124
1125           ;; Current character = left slash (escape)
1126           ((equal (aref debugger-output curr-pos) ?\\)
1127            (if in-string-p
1128                (setq in-escape-p (not in-escape-p))))
1129
1130           ;; Current character = quotation mark
1131           ((equal (aref debugger-output curr-pos) ?\")
1132            (if in-string-p
1133                (if in-escape-p
1134                    (progn
1135                      (setq in-escape-p nil)
1136                      (setq in-string-p nil))
1137                  (setq in-string-p nil))
1138              (setq in-string-p t)))
1139
1140           ;; Current character = right paren
1141           ((and
1142             (not in-string-p)
1143             (equal (aref debugger-output curr-pos) ?\)))
1144            (if (= level 0)
1145                (throw 'found-lisp-form curr-pos)
1146              (setq level (1- level))
1147              (if (< level 0)
1148                  (error "Error parsing debugger output.")))
1149            ;; (prin1 (format ") lev = %d pos = %d" level curr-pos) (current-buffer))
1150            )
1151
1152           ;; Current character = left paren
1153           ((and
1154             (not in-string-p)
1155             (equal (aref debugger-output curr-pos) ?\()
1156                (setq level (1+ level)))
1157            ;; (prin1 (format "( lev = %d pos = %d" level curr-pos) (current-buffer))
1158            )
1159           (t
1160            (if in-escape-p
1161                (setq in-escape-p nil))))
1162
1163          (setq curr-pos (1+ curr-pos)))
1164
1165        -1))
1166     (if (> lisp-form-end 1)
1167         (progn
1168           (setq lisp-form (substring debugger-output 0 (1+ lisp-form-end)))
1169           (when (< lisp-form-end (1- output-length))
1170             (setq remainder (substring debugger-output (1+ lisp-form-end) output-length))
1171             (if (string-match "(" remainder)
1172                 (setq remainder (substring remainder (string-match "(" remainder)))
1173               (setq remainder ""))))
1174       (setq remainder debugger-output))
1175     (cons lisp-form remainder)))
1176
1177 (defun jde-dbs-reply-p (form)
1178   "Returns t if FORM is a command response form."
1179   (or
1180    (string-match "jde-dbo-command-result" form)
1181    (string-match "jde-dbo-command-error" form)))
1182
1183 (defvar jde-dbs-reply-received nil
1184 "Value to let us know a reply to a command has been received")
1185
1186 (defvar jde-dbs-pending-event-queue nil
1187 "Queue of events that occurred before receiving a reply to the last command.")
1188
1189 (defun jde-dbs-command-reply-listener (process output)
1190   "Listens for a reply to the command specified by
1191 `jde-dbs-pending-command'."
1192   ;; (message "entering command reply listener")
1193   (let* ((combined-output (concat jde-dbs-debugger-output output))
1194          (parsed-output
1195           (if (string-match "^[\n\t ]*(" combined-output)
1196               (jde-dbs-extract-lisp-form combined-output)
1197             (jde-dbs-extract-exception combined-output)))
1198          (form (car parsed-output))
1199          (remainder (cdr parsed-output)))
1200
1201     ;; (message "form: %s" form)
1202     ;; (message "remainder: %s" remainder)
1203
1204     ;; Insert debugger output into the *JDEbug* buffer.
1205     (funcall (oref jde-dbs-the-debugger  comint-filter)
1206          process output)
1207
1208     ;; Process the Lisp forms extracted from the debugger output.
1209     (while (not (string= form ""))
1210
1211       (if (jde-dbs-reply-p form)
1212
1213           ;; The current form is a reply to a debugger command.
1214           (progn
1215             (setq jde-dbs-command-reply form)
1216             (setq jde-dbs-reply-received t))
1217
1218         ;; The form is an event. Postpone processing the event
1219         ;; until we receive a reply to the last command.
1220         ;; (message "   appending %s to pending event queue" form)
1221         (setq jde-dbs-pending-event-queue
1222               (append jde-dbs-pending-event-queue (list form))))
1223
1224       ;; Extract the next Lisp form from the debugger output.
1225       ;; The car of parsed-output is the next form. The cdr
1226       ;; is the remaining unprocessed debugger output.
1227       (setq parsed-output
1228             (jde-dbs-extract-lisp-form remainder))
1229
1230       (setq form (car parsed-output))
1231       (setq remainder (cdr parsed-output))) ;; End of form processing loop.
1232
1233     (setq jde-dbs-debugger-output remainder)
1234
1235     (if (not jde-dbs-reply-received)
1236         (when (not (accept-process-output process jde-bug-debugger-command-timeout 0))
1237             (message "No response to command %d. (process = %s; timeout = %s sec.)"
1238                      jde-dbs-pending-command
1239                      (if (jde-dbs-get-target-process)
1240                          (oref (jde-dbs-get-target-process) id)
1241                        "?")
1242                      jde-bug-debugger-command-timeout)
1243                     (setq jde-dbs-command-reply nil)))))
1244
1245 (defun jde-dbs-asynch-output-listener (process output)
1246   "Listens for asynchronous debugger output."
1247   (let* ((combined-output (concat jde-dbs-debugger-output output))
1248          (parsed-output
1249           (if (string-match "^[\n\t ]*(" combined-output)
1250               (jde-dbs-extract-lisp-form combined-output)
1251             (jde-dbs-extract-exception combined-output)))
1252          (lisp-form (car parsed-output))
1253          (remainder (cdr parsed-output))
1254          events)
1255
1256     ;; (message "asynch form: %s" lisp-form)
1257     ;; (message "asynch remainder: %s" remainder)
1258
1259     (funcall (oref  jde-dbs-the-debugger comint-filter)
1260              process output)
1261     ;; Extract events from debugger output.
1262     (while (not (string= lisp-form ""))
1263       ;; (message "   evaluating %s" lisp-form)
1264       ;; (jde-dbs-eval-debugger-output lisp-form)
1265       (setq events (append events (list lisp-form)))
1266       (setq parsed-output
1267             (jde-dbs-extract-lisp-form remainder))
1268       (setq lisp-form (car parsed-output))
1269       (setq remainder (cdr parsed-output)))
1270     (setq jde-dbs-debugger-output remainder)
1271     (if events
1272         (mapc (lambda (event) (jde-dbs-eval-debugger-output event))
1273               events))))
1274
1275 (defun jde-dbs-do-command (vm command)
1276   "Posts the specified command to the debugger and returns its response."
1277   (let* ((debugger-process
1278           (oref jde-dbs-the-debugger process))
1279          (previous-listener (process-filter debugger-process))
1280          cmd)
1281     (setq jde-dbs-debugger-output "")
1282     (setq jde-dbs-command-reply "")
1283     (setq jde-dbs-reply-received nil)
1284     (setq jde-dbs-pending-event-queue nil)
1285     (setq jde-dbs-cmd-counter (+ jde-dbs-cmd-counter 1))
1286     (setq jde-dbs-pending-command (number-to-string jde-dbs-cmd-counter))
1287     (setq cmd (concat (number-to-string vm) " " jde-dbs-pending-command " " command "\n\n"))
1288     (jde-dbs-debugger-display-message jde-dbs-the-debugger (concat "JDE> " cmd))
1289     (set-process-filter debugger-process 'jde-dbs-command-reply-listener)
1290     (process-send-string debugger-process cmd)
1291     (when (not (accept-process-output debugger-process jde-bug-debugger-command-timeout 0))
1292                 (message "Error: debugger didn't respond to command:\n%s" cmd)
1293                 (setq jde-dbs-command-reply nil))
1294     (set-process-filter debugger-process previous-listener)
1295     (if jde-dbs-command-reply
1296         (let ((result (jde-dbs-eval-debugger-output jde-dbs-command-reply)))
1297           ;; evaluate any events that occurred between issuance and
1298           ;; acknowledgement of this command
1299           (mapc (lambda (event) (jde-dbs-eval-debugger-output event))
1300                 jde-dbs-pending-event-queue)
1301           (setq jde-dbs-pending-event-queue nil)
1302           result))))
1303
1304
1305
1306 (defvar jde-dbs-debugger-socket-number nil
1307 "Number of socket used to communicate with debugger.")
1308
1309
1310 (defmethod jde-dbs-cmd-success-action ((this jde-dbs-cmd)))
1311
1312
1313 (defmethod jde-dbs-cmd-failure-action ((this jde-dbs-cmd)))
1314
1315
1316 (defmethod jde-dbs-cmd-display-response ((this jde-dbs-cmd))
1317   (if (slot-boundp this 'msg)
1318       (jde-dbs-proc-display-debug-message
1319        (oref this process)
1320        (oref this msg))))
1321
1322 (defmethod jde-dbs-cmd-execute-pending-events ((this jde-dbs-cmd))
1323   "Evaluate any events that occurred between issuance and
1324    acknowledgement of this command"
1325   (let ((events jde-dbs-pending-event-queue))
1326     ;; Empty queue to avoid recursion if commands are executed
1327     ;; as a result of processing these events.
1328     (setq jde-dbs-pending-event-queue nil)
1329     (mapc (lambda (event) (jde-dbs-eval-debugger-output event))
1330                 events)))
1331
1332
1333 (defmethod jde-dbs-cmd-exec ((this jde-dbs-cmd))
1334   "Posts the specified command to the debugger and returns its response."
1335   (let* ((debugger-process
1336           (oref jde-dbs-the-debugger process))
1337          (previous-listener (process-filter debugger-process))
1338          (target-process (oref this process))
1339          (command-line (format "%s\n" (jde-dbs-cmd-make-command-line this))))
1340
1341     (setq jde-dbs-debugger-output "")
1342     (setq jde-dbs-command-reply "")
1343     (setq jde-dbs-reply-received nil)
1344     (setq jde-dbs-pending-event-queue nil)
1345     (setq jde-dbs-pending-command (oref this id))
1346
1347     (if target-process (oset target-process last-cmd this))
1348     (jde-dbs-debugger-display-message jde-dbs-the-debugger (concat "JDE> " command-line))
1349     (set-process-filter debugger-process 'jde-dbs-command-reply-listener)
1350     (process-send-string debugger-process command-line)
1351     (process-send-string debugger-process "\n")
1352
1353     (when (not (accept-process-output debugger-process jde-bug-debugger-command-timeout 0))
1354                 (message "Error: debugger didn't respond to command:\n%s" command-line)
1355                 (setq jde-dbs-command-reply nil))
1356
1357     (process-send-string debugger-process "\n")
1358
1359     (set-process-filter debugger-process previous-listener)
1360
1361     (if jde-dbs-command-reply
1362         (let ((result (jde-dbs-eval-debugger-output jde-dbs-command-reply)))
1363
1364           (oset this :result result)
1365
1366           (oset this :data (car (jde-dbo-command-result-data (oref this result))))
1367
1368           (if (jde-dbo-command-succeeded-p result)
1369               (jde-dbs-cmd-success-action this)
1370             (jde-dbs-cmd-failure-action this))
1371
1372           (jde-dbs-cmd-display-response this)
1373
1374           (jde-dbs-cmd-execute-pending-events this)
1375           (oref this :result)))))
1376
1377 (defvar jde-dbs-cmd-counter 0
1378  "Count of the number of commands issued in this session.")
1379
1380
1381 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1382 ;;                                                                            ;;
1383 ;; Launch Process Command                                                     ;;
1384 ;;                                                                            ;;
1385 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1386 (defclass jde-dbs-launch-process (jde-dbs-cmd)
1387   ((main-class  :initarg :main-class
1388                 :type string
1389                 :documentation
1390                 "Class containing this process's main method.")
1391    (jre-home    :initarg :jre-home
1392                 :type string
1393                 :documentation
1394                 "Home directory of JRE used to launch this process.")
1395    (vmexec     :initarg :vmexec
1396                 :type string
1397                 :initform "java"
1398                 :documentation
1399                 "Name of vm executable used to run process.")
1400    (vm-args     :initarg :args
1401                 :type string
1402                 :initform ""
1403                 :documentation
1404                 "Command line arguments to be passed to vm's main method.")
1405    (app-args    :initarg :app-args
1406                 :type string
1407                 :initform ""
1408                 :documentation
1409                 "Command line arguments to be passed to app's main method."))
1410   "Command to launch a debuggee process.")
1411
1412 (defun jde-dbs-get-app-buffer-name ()
1413   (concat "*" (jde-run-get-main-class) "*"))
1414
1415 (defmethod initialize-instance ((this jde-dbs-launch-process) &rest fields)
1416   "Constructor for debugger commands. Generates a unique id for this command."
1417
1418   ;; Call parent initializer.
1419   (call-next-method)
1420
1421   ;; Set command name.
1422   (oset this name "launch")
1423
1424   ;; You must specify a process to launch when constructing a launch command."
1425   (assert (slot-boundp this :process))
1426
1427   ;; Set main class.
1428   (if (not (slot-boundp this :main-class))
1429     (oset this :main-class
1430           (oref (oref this :process) :main-class)))
1431
1432   ;; Set vm.
1433   ;; (oset this vm (jde-dbs-choose-vm))
1434
1435   ;; Set vm args
1436   (oset this vm-args
1437         (concat (mapconcat (lambda (s) s) (jde-db-get-vm-args jde-dbs-the-debugger) " ")
1438                 " "
1439                 (mapconcat (lambda (s) s) (jde-db-get-vm-args-from-user) " ")))
1440
1441
1442   ;; Set application arguments.
1443   (oset this app-args
1444         (concat
1445          (if jde-db-option-application-args
1446              (mapconcat (lambda (s) s) jde-db-option-application-args " ")
1447            "")
1448          " "
1449          (mapconcat (lambda (s) s) (jde-db-get-app-args-from-user) " "))))
1450
1451
1452
1453 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-launch-process))
1454   "Creates the command line for the launch command."
1455   (let ((cmd (format "-1 %s %s %s -vmexec %s"
1456                      (oref this id)                    ;; cid
1457                      (oref this name)                  ;; launch
1458                      (oref (oref this process) id)     ;; pid
1459                      (oref this vmexec))))
1460
1461     (if (slot-boundp this 'jre-home)
1462         (setq cmd (concat cmd " -home " (oref this jre-home))))
1463
1464     (setq cmd
1465           (format "%s %s %s %s"
1466                   cmd
1467                   (oref this vm-args)            ;; vm args
1468                   (oref this main-class)         ;; main class
1469                   (oref this app-args)))         ;; command line args
1470
1471     (oset this msg
1472           (format "Launch command line:\n  %s %s %s %s\n"
1473                   (oref this vmexec)
1474                   (oref this vm-args)            ;; vm args
1475                   (oref this main-class)         ;; main class
1476                   (oref this app-args)))         ;; command line args
1477     cmd))
1478
1479 (defmethod jde-dbs-cmd-success-action ((this jde-dbs-launch-process))
1480   (call-next-method)
1481   (delete-other-windows)
1482   (let* ((process (oref this process))
1483          (main-class (oref this main-class))
1484          (source-buffer (current-buffer))
1485          (cli-socket
1486           (car (jde-dbo-command-result-data (oref this result))))
1487          (cli-buffer-name
1488           (format "%s(%d) CLI" main-class (oref process id))))
1489
1490     (oset process cli-socket cli-socket)
1491
1492     ;; Connect to socket used by debugger to transport the
1493     ;; standard I/O of the debuggee process.
1494     (sleep-for jde-bug-sio-connect-delay)
1495     (oset
1496      process
1497      cli-buf
1498      (make-comint
1499       cli-buffer-name
1500       (cons jde-bug-debugger-host-address cli-socket)))
1501
1502     (oset this msg
1503           (format "%s\nEmacs connected to standard IO port %d for process %s."
1504                   (oref this msg)
1505                   cli-socket
1506                   (oref this main-class)))
1507
1508     (pop-to-buffer (oref process msg-buf))
1509     (pop-to-buffer source-buffer)
1510     (pop-to-buffer source-buffer)
1511     (oset process win-cfg (current-window-configuration))))
1512
1513 (defmethod jde-dbs-cmd-failure-action ((this jde-dbs-launch-process))
1514   (delete-other-windows)
1515   (let* ((process (oref this process))
1516          (source-buffer (current-buffer)))
1517     (oset this  msg
1518           (format "%s\nError: debugger unable to launch %s.\n  Reason: %s"
1519                   (oref this msg)
1520                   (oref this main-class)
1521                   (oref this data)))
1522       (split-window-vertically)
1523       (pop-to-buffer (oref process msg-buf))
1524       (pop-to-buffer source-buffer)
1525       (oset process win-cfg (current-window-configuration))))
1526
1527 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1528 ;;                                                                            ;;
1529 ;; Attach Shared Memory                                                       ;;
1530 ;;                                                                            ;;
1531 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1532 (defclass jde-dbs-attach-shmem (jde-dbs-cmd)
1533   ((process-name  :initarg :process-name
1534                   :type string
1535                   :documentation
1536                   "Name of process to attach."))
1537   "Attach debugger to a running process via shared memory.")
1538
1539 (defmethod initialize-instance ((this jde-dbs-attach-shmem) &rest fields)
1540   "Constructor for attach_shmem command."
1541
1542   ;; Call parent initializer.
1543   (call-next-method)
1544
1545   (assert (oref this process))
1546
1547   (assert (slot-boundp this 'process-name))
1548
1549   ;; Set command name.
1550   (oset this name "attach_shmem"))
1551
1552 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-attach-shmem))
1553   "Creates the command line for the attach_shmem command."
1554   (format "-1 %s %s %s %s"
1555           (oref this id)
1556           (oref this name)                 ;; command name
1557           (oref (oref this process) id)    ;; process id
1558           (oref this process-name)))       ;; process name
1559
1560 (defmethod jde-dbs-cmd-success-action ((this jde-dbs-attach-shmem))
1561   (call-next-method)
1562   (delete-other-windows)
1563   (let* ((process (oref this process))
1564          (source-buffer (current-buffer)))
1565     (oset process :attachedp t)
1566     (oset process :startupp t)
1567     (oset this msg  (format "Attached to process %s."
1568                             (oref this process-name)))
1569     (split-window-vertically)
1570     (pop-to-buffer (oref process msg-buf))
1571     (pop-to-buffer source-buffer)
1572     (oset process win-cfg (current-window-configuration))))
1573
1574 (defmethod jde-dbs-cmd-failure-action ((this jde-dbs-attach-shmem))
1575   (delete-other-windows)
1576   (let* ((process (oref this process))
1577          (source-buffer (current-buffer)))
1578     (oset this  msg
1579      (format "Error: cannot attach process %s.\n Reason: %s."
1580                     (oref this process-name)
1581                     (oref this data)))
1582       (split-window-vertically)
1583       (pop-to-buffer (oref process msg-buf))
1584       (pop-to-buffer source-buffer)
1585       (oset process win-cfg (current-window-configuration))))
1586
1587
1588 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1589 ;;                                                                            ;;
1590 ;; Attach Process via Socket                                                  ;;
1591 ;;                                                                            ;;
1592 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1593 (defclass jde-dbs-attach-socket (jde-dbs-cmd)
1594   ((port  :initarg :port
1595           :type string
1596           :documentation
1597           "Name of port on which existing process is listening.")
1598    (host  :initarg :host
1599           :type string
1600           :documentation
1601           "Name of host on which existing process is listening."))
1602   "Attach debugger to a running process via a socket connection.")
1603
1604 (defmethod initialize-instance ((this jde-dbs-attach-socket) &rest fields)
1605   "Constructor for attach_socket command."
1606
1607   ;; Call parent initializer.
1608   (call-next-method)
1609
1610   (assert (oref this process))
1611
1612   (assert (slot-boundp this 'port))
1613
1614   ;; Set command name.
1615   (oset this name "attach_socket"))
1616
1617 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-attach-socket))
1618   "Creates the command line for the attach_socket command."
1619   (let ((cmd
1620          (format "-1 %s %s %s -port %s"
1621           (oref this id)
1622           (oref this name)                 ;; command name
1623           (oref (oref this process) id)    ;; process id
1624           (oref this port))))              ;; process name
1625     (if (slot-boundp this 'host)
1626         (setq cmd (format "%s -host %s" cmd (oref this host))))
1627     cmd))
1628
1629 (defmethod jde-dbs-cmd-success-action ((this jde-dbs-attach-socket))
1630   (call-next-method)
1631   (delete-other-windows)
1632   (let* ((process (oref this process))
1633         (source-buffer (current-buffer)))
1634     (oset process attachedp t)
1635     (oset process startupp t)
1636     (oset this msg  (format "Attached to process on port %s of %s."
1637                             (oref this port)
1638                             (if (slot-boundp this 'host)
1639                                 (oref this host)
1640                               "local host")))
1641     (split-window-vertically)
1642     (pop-to-buffer (oref process msg-buf))
1643     (pop-to-buffer source-buffer)
1644     (oset process win-cfg (current-window-configuration))))
1645
1646 (defmethod jde-dbs-cmd-failure-action ((this jde-dbs-attach-socket))
1647   (delete-other-windows)
1648   (let* ((process (oref this process))
1649          (source-buffer (current-buffer)))
1650     (oset this  msg
1651      (format "Error: cannot attach to process on port %s of %s.\n Reason: %s."
1652              (oref this port)
1653              (if (slot-boundp this 'host)
1654                  (oref this host)
1655                "local host")
1656              (oref this data)))
1657       (split-window-vertically)
1658       (pop-to-buffer (oref process msg-buf))
1659       (pop-to-buffer source-buffer)
1660       (oset process win-cfg (current-window-configuration))))
1661
1662 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1663 ;;                                                                            ;;
1664 ;; Listen for Process                                                         ;;
1665 ;;                                                                            ;;
1666 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1667 (defclass jde-dbs-listen-for-process (jde-dbs-cmd)
1668   ((address   :initarg :address
1669               :type string
1670               :documentation
1671               "Address at which to listen for a debuggee process.")
1672    (transport :initarg :transport
1673               :type string
1674               :initform "shmem"
1675               :documentation
1676               "Transport mechanism used to interact with debuggee process."))
1677   "Listen for a process requesting debugger services.")
1678
1679 (defmethod initialize-instance ((this jde-dbs-listen-for-process) &rest fields)
1680   "Constructor for listen command."
1681
1682   ;; Call parent initializer.
1683   (call-next-method)
1684
1685   (assert (oref this process))
1686
1687   (assert (slot-boundp this 'address))
1688
1689   (assert (not
1690            (and
1691             (not (eq system-type 'windows-nt))
1692             (string= (oref this transport) "shmem"))))
1693
1694   ;; Set command name.
1695   (oset this name
1696         (concat "listen_"
1697                 (oref this transport))))
1698
1699 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-listen-for-process))
1700   "Creates the command line for the listen command."
1701   (format "-1 %s %s %s %s"
1702           (oref this id)
1703           (oref this name)                 ;; command name
1704           (oref (oref this process) id)    ;; process id
1705           (oref this address)))            ;; process address
1706
1707 (defmethod jde-dbs-cmd-success-action ((this jde-dbs-listen-for-process))
1708   (call-next-method)
1709   (delete-other-windows)
1710   (let* ((process (oref this process))
1711         (source-buffer (current-buffer)))
1712     (oset this msg  (format "Listening for process at %s address: %s."
1713                             (if (string= (oref this transport) "shmem")
1714                                 "shared memory" "socket")
1715                             (oref this address)))
1716     (oset process startupp t)
1717     (split-window-vertically)
1718     (pop-to-buffer (oref process msg-buf))
1719     (pop-to-buffer source-buffer)
1720     (oset process win-cfg (current-window-configuration))))
1721
1722 (defmethod jde-dbs-cmd-failure-action ((this jde-dbs-listen-for-process))
1723   (delete-other-windows)
1724   (let* ((process (oref this process))
1725          (source-buffer (current-buffer)))
1726     (oset this  msg
1727      (format "Error: cannot listen for process at %s address: %s.\n Reason: %s."
1728              (if (string= (oref this transport) "shmem")
1729                  "shared memory" "socket")
1730              (oref this address)
1731              (oref this data)))
1732       (split-window-vertically)
1733       (pop-to-buffer (oref process msg-buf))
1734       (pop-to-buffer source-buffer)
1735       (oset process win-cfg (current-window-configuration))))
1736
1737
1738
1739 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1740 ;;                                                                            ;;
1741 ;; Run Process Command Class                                                  ;;
1742 ;;                                                                            ;;
1743 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1744 (defclass jde-dbs-run-process (jde-dbs-cmd) ()
1745   "Run process command.")
1746
1747 (defmethod initialize-instance ((this jde-dbs-run-process) &rest fields)
1748   "Constructor for run process command."
1749
1750   ;; Call parent initializer.
1751   (call-next-method)
1752
1753   (assert (oref this process))
1754
1755   ;; Set command name.
1756   (oset this name "run"))
1757
1758
1759 (defmethod jde-dbs-cmd-success-action ((this jde-dbs-run-process))
1760   (call-next-method)
1761   (oset this msg (format "Running %s."
1762                          (oref (oref this process)  main-class))))
1763
1764 (defmethod jde-dbs-cmd-failure-action ((this jde-dbs-run-process))
1765   (oset this msg
1766         (format "Error: unable to run %s..\n  Reason: %s."
1767                 (oref (oref this process) main-class)
1768                 (oref this result))))
1769
1770
1771 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1772 ;;                                                                            ;;
1773 ;; Finish Process Command Class                                               ;;
1774 ;;                                                                            ;;
1775 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1776 (defclass jde-dbs-finish-process (jde-dbs-cmd) ()
1777   "Finish process command.")
1778
1779 (defmethod initialize-instance ((this jde-dbs-finish-process) &rest fields)
1780   "Constructor for finish process command."
1781
1782   ;; Call parent initializer.
1783   (call-next-method)
1784
1785   (assert (slot-boundp this :process))
1786
1787   ;; Set command name.
1788   (oset this name "finish"))
1789
1790 (defmethod jde-dbs-cmd-exec ((this jde-dbs-finish-process))
1791   "Executes the finish process command."
1792   (let* ((process (oref this :process))
1793          (main-class (oref process :main-class))
1794          (result (call-next-method)))
1795     (if (jde-dbo-command-succeeded-p result)
1796         (progn
1797           (jde-dbs-proc-display-debug-message process
1798            (concat "Terminating " main-class)))
1799       (jde-dbs-proc-display-debug-message process
1800        (concat "Error: debugger unable to terminate: "
1801                main-class
1802                ".\n  Reason: "
1803                (car (jde-dbo-command-result-data result))))
1804       nil)))
1805
1806
1807 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1808 ;;                                                                            ;;
1809 ;; Set Breakpoint Command Class                                               ;;
1810 ;;                                                                            ;;
1811 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1812 (defclass jde-dbs-set-breakpoint (jde-dbs-cmd)
1813   ((breakpoint    :initarg :breakpoint
1814                   :type jde-db-breakpoint
1815                   :documentation
1816                   "Breakpoint specification."))
1817   "Set breakpoint command.")
1818
1819 (defmethod initialize-instance ((this jde-dbs-set-breakpoint) &rest fields)
1820   "Constructor for set breakpoint command."
1821
1822   ;; Call parent initializer.
1823   (call-next-method)
1824
1825   (assert (oref this process))
1826   (assert (oref this breakpoint))
1827
1828   ;; Set command name.
1829   (oset this name "break absolute"))
1830
1831 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-set-breakpoint))
1832   "Creates the command line for the set breakpoint command."
1833   (let* ((bp-spec (oref this breakpoint))
1834          (file (file-name-nondirectory (oref bp-spec file)))
1835          (line (jde-db-breakpoint-get-line bp-spec)))
1836     (format "%s %s %s"
1837             (call-next-method)
1838             file     ;; File
1839             line)))  ;; Line number
1840
1841 (defmethod jde-dbs-cmd-success-action ((this jde-dbs-set-breakpoint))
1842   (call-next-method)
1843   (let*  ((process (oref this process))
1844           (bp-procid (oref this data))
1845           (bp-spec (oref this breakpoint))
1846           (file (oref bp-spec file))
1847           (line (jde-db-breakpoint-get-line bp-spec))
1848           (bpspec (jde-dbs-proc-bpspec "spec" :id bp-procid :breakpoint bp-spec))
1849           (bpspecs (if (slot-boundp process :bpspecs) (oref process :bpspecs))))
1850     (if bpspecs
1851         (oset process bpspecs (jde-dbs-proc-bpspecs-add bpspecs bpspec))
1852       (oset process bpspecs (jde-dbs-proc-bpspecs-add nil bpspec)))
1853     (oset this msg (format "Setting breakpoint at line %s in %s." line file))))
1854
1855
1856 (defmethod jde-dbs-cmd-failure-action ((this jde-dbs-set-breakpoint))
1857   (let* ((bp-spec (oref this breakpoint))
1858          (file (oref bp-spec file))
1859          (line (jde-db-breakpoint-get-line bp-spec)))
1860     (oset this msg  (format "Error: cannot set breakpoint at line %s in file %s.\n  Reason:"
1861                             file line (oref this data)))))
1862
1863 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1864 ;;                                                                            ;;
1865 ;; Clear Breakpoint Command Class                                             ;;
1866 ;;                                                                            ;;
1867 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1868 (defclass jde-dbs-clear-breakpoint (jde-dbs-cmd)
1869   ((breakpoint    :initarg :breakpoint
1870                   :type jde-db-breakpoint
1871                   :documentation
1872                   "Breakpoint specification."))
1873   "Set breakpoint command.")
1874
1875 (defmethod initialize-instance ((this jde-dbs-clear-breakpoint) &rest fields)
1876   "Constructor for clear breakpoint command."
1877
1878   ;; Call parent initializer.
1879   (call-next-method)
1880
1881   (assert (oref this process))
1882   (assert (oref this breakpoint))
1883
1884   ;; Set command name.
1885   (oset this name "clear"))
1886
1887 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-clear-breakpoint))
1888   "Creates the command line for the clear breakpoint command."
1889   (let* ((process (oref this process))
1890          (breakpoint (oref this breakpoint))
1891          (bpspec (jde-dbs-proc-get-bpspec process breakpoint))
1892          (bp-procid (oref bpspec id)))
1893     (format "%s %s"              ;; PID CID clear BPID
1894             (call-next-method)
1895             bp-procid)))         ;; Id assigned by debugger to this breakpoint
1896
1897
1898 (defmethod jde-dbs-cmd-exec ((this jde-dbs-clear-breakpoint))
1899   "Execute clear breakpoint command."
1900   (let* ((process (oref this process))
1901          (breakpoint (oref this breakpoint))
1902          (file (oref breakpoint file))
1903          (line (jde-db-breakpoint-get-line breakpoint))
1904          (proc-id (oref process id))
1905          (bpspec (jde-dbs-proc-get-bpspec process breakpoint)))
1906     (if bpspec
1907         (let ((bp-procid (oref bpspec id))
1908               (result (call-next-method)))
1909           (if (jde-dbo-command-succeeded-p result)
1910               (let ((bpspecs (oref process bpspecs)))
1911                 (oset process bpspecs
1912                       (jde-dbs-proc-bpspecs-remove bpspecs bpspec))
1913                 (jde-dbs-proc-display-debug-message
1914                  process
1915                  (format "Cleared breakpoint at line %s in file %s" line file)))
1916             (jde-dbs-proc-display-debug-message
1917              process
1918              (format "Error: cannot clear breakpoint at line %s in file %s.\n Reason: %s."
1919                      line file (car (jde-dbo-command-result-data result))))
1920             nil)))))
1921
1922 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1923 ;;                                                                            ;;
1924 ;; Step Over/Into/Out Command Class                                           ;;
1925 ;;                                                                            ;;
1926 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1927
1928 (defclass jde-dbs-step (jde-dbs-cmd)
1929   ((step-type :initarg :step-type
1930               :type string
1931               :initform "over"
1932               :documentation
1933               "Type of step operation: over, into, into-all, out"))
1934   "Step command.")
1935
1936 (defmethod initialize-instance ((this jde-dbs-step) &rest fields)
1937   "Constructor for step command."
1938
1939   ;; Call parent initializer.
1940   (call-next-method)
1941
1942   (assert (oref this process))
1943
1944
1945   ;; Set command name.
1946   (oset this name (concat "step " (oref this step-type))))
1947
1948 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-step))
1949   "Creates the command line for the step command."
1950   (format "%s %d" (call-next-method)
1951           (oref (oref (oref this process) state-info) thread-id)))
1952
1953
1954 (defmethod jde-dbs-cmd-failure-action ((this jde-dbs-step))
1955   (oset this msg
1956         (format "Error: unable to step %s.\n Reason: %s"
1957                 (oref this step-type) (oref this data))))
1958
1959
1960
1961 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1962 ;;                                                                            ;;
1963 ;; Step Into Command Class                                                    ;;
1964 ;;                                                                            ;;
1965 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1966 (defmethod jde-dbs-proc-step-into ((this jde-dbs-proc))
1967   (let* ((proc-id (oref this id))
1968          (thread-id
1969           (oref (oref this state-info) thread-id))
1970          (result (jde-dbs-do-command proc-id  (format "step into %s" thread-id))))
1971     (when (not (jde-dbo-command-succeeded-p result))
1972       (jde-dbs-proc-display-debug-message this
1973        (format "Error: unable to step into... .\n  Reason: %s"
1974                (car (jde-dbo-command-result-data result))))
1975       nil)))
1976
1977 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1978 ;;                                                                            ;;
1979 ;; Step Out Command Class                                                     ;;
1980 ;;                                                                            ;;
1981 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1982 (defmethod jde-dbs-proc-step-out ((this jde-dbs-proc))
1983   (let* ((proc-id (oref this id))
1984          (thread-id
1985           (oref (oref this state-info) thread-id))
1986          (result (jde-dbs-do-command proc-id  (format "step out %s" thread-id))))
1987     (when (not (jde-dbo-command-succeeded-p result))
1988       (jde-dbs-proc-display-debug-message this
1989        (format "Error: unable to step into... .\n  Reason: %s"
1990                (car (jde-dbo-command-result-data result))))
1991       nil)))
1992
1993 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1994 ;;                                                                            ;;
1995 ;; Evaluate Command Class                                                     ;;
1996 ;;                                                                            ;;
1997 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1998 (defclass jde-dbs-evaluate (jde-dbs-cmd)
1999   ((expression    :initarg :expression
2000                   ;; :type string
2001                   :documentation
2002                   "Expression to be evaluate. Required.")
2003    (thread-id     :initarg :thread-id
2004                   ;; :type integer
2005                   :documentation
2006                   "Id of thread that scopes this expression. Required."))
2007   "Evaluate expression command.")
2008
2009 (defmethod initialize-instance ((this jde-dbs-evaluate) &rest fields)
2010   "Constructor for evaluate command."
2011
2012   ;; Call parent initializer.
2013   (call-next-method)
2014
2015   (assert (oref this process))
2016   (assert (oref this expression))
2017   (assert (oref this thread-id))
2018
2019   ;; Set command name.
2020   (oset this name "evaluate"))
2021
2022 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-evaluate))
2023   "Creates the command line for the clear breakpoint command."
2024     (format "%s %s 0 \"%s\""         ;; PID CID evaluate THREAD-ID 0 "EXPRESSION"
2025             (call-next-method)       ;; PID CID evaluate
2026             (oref this thread-id)    ;; thread id
2027             (oref this expression))) ;; expression to be evaluated.
2028
2029
2030 (defmethod jde-dbs-cmd-exec ((this jde-dbs-evaluate))
2031   "Execute evaluate expression command. Returns
2032 (TYPE VALUE GCFLAG) where TYPE is the type of the result,
2033 VALUE is the value, and GCFLAG is t if the result has been
2034 garbage collected."
2035   (let* ((process (oref this process))
2036          (result (call-next-method)))
2037     (if (jde-dbo-command-succeeded-p result)
2038         (car (jde-dbo-command-result-data result))
2039       (jde-dbs-proc-display-debug-message
2040        process
2041        (format "Error: cannot evaluate \"%s\".\n Reason: %s."
2042                (oref this expression)
2043                (car (jde-dbo-command-result-data result))))
2044       nil)))
2045
2046
2047 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2048 ;;                                                                            ;;
2049 ;; Get Array                                                                  ;;
2050 ;;                                                                            ;;
2051 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2052 (defclass jde-dbs-get-array (jde-dbs-cmd)
2053   ((array    :initarg :array
2054              :type jde-dbs-java-array
2055              :documentation
2056              "Object to represent the array. Required.")
2057    (index    :initarg :index
2058              :type integer
2059              :documentation
2060              "Index of array slice to be returned.")
2061    (length   :initarg :length
2062              :type integer
2063              :documentation "Length of slice to be returned."))
2064   "Get a slice of the array object specified by ARRAY. INDEX and LENGTH are
2065 the index and length of the slice to be returned. If omitted, this command returns
2066 the length of the first slice of the array. Note that each element of this array
2067 can be another array or some other object.")
2068
2069
2070 (defmethod initialize-instance ((this jde-dbs-get-array) &rest fields)
2071   "Constructor for get array command."
2072
2073   ;; Call parent initializer.
2074   (call-next-method)
2075
2076   (assert (slot-boundp this :process))
2077   (assert (slot-boundp this :array))
2078
2079   (if (slot-boundp this :index)
2080       (assert (slot-boundp this :length)))
2081
2082   ;; Set command name.
2083   (oset this name "get_array"))
2084
2085 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-get-array))
2086   "Creates the command line for the get-object command."
2087   (let ((cl
2088          (format "%s %d" (call-next-method) (oref (oref this array) id)))
2089         (index (if (slot-boundp this :index) (oref this :index))))
2090     (if index
2091         (setq cl
2092               (format "%s %d %d"                ;; PID CID get_array OBJ-ID INDEX LENGTH
2093                       cl
2094                       index                     ;; index of slice to be returned.
2095                       (oref this length))))    ;; length of slice to be returned.
2096     cl))
2097
2098
2099 (defmethod jde-dbs-cmd-exec ((this jde-dbs-get-array))
2100   "Executes the get-array command. If a slice is specified,
2101 returns the slice as a list of elements. Otherwise, return
2102 the length of the array."
2103   (let* ((process (oref this process))
2104          (result (call-next-method)))
2105     (if (jde-dbo-command-succeeded-p result)
2106         (let* ((array (oref this array))
2107                (data   (nth 0 (jde-dbo-command-result-data result)))
2108                (type (nth 0 data))
2109                (id (nth 1 data))
2110                (gc-flag (nth 2 data))
2111                (length (nth 3 data))
2112                (elements (if (> (length data) 4)
2113                              (cdr (cdr (cdr (cdr data)))))))
2114           (or elements length)
2115           (oset array jtype type)
2116           (oset array id id)
2117           (oset array gc-flag gc-flag)
2118           (oset array length length)
2119           (oset array elements
2120                 (mapcar
2121                  (lambda (element)
2122                    (jde-dbs-objectify-value element))
2123                  elements))
2124           array)
2125       (jde-dbs-proc-display-debug-message
2126        process
2127        (format "Error: cannot get array %d.\n Reason: %s."
2128                (oref this object-id)
2129                (car (jde-dbo-command-result-data result))))
2130       nil)))
2131
2132
2133 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2134 ;;                                                                            ;;
2135 ;; Abstract Get Object                                                        ;;
2136 ;;                                                                            ;;
2137 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2138 (defclass jde-dbs-abstract-get-object (jde-dbs-cmd)
2139   ((object-id     :initarg :object-id
2140                   :type integer
2141                   :documentation
2142                   "Id of object. Required."))
2143   "Parent class of get object commands.")
2144
2145
2146 (defmethod initialize-instance ((this jde-dbs-abstract-get-object) &rest fields)
2147   "Constructor for get-object command."
2148
2149   ;; Call parent initializer.
2150   (call-next-method)
2151
2152   (assert (slot-boundp this :process))
2153   (assert (slot-boundp this :object-id)))
2154
2155 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-abstract-get-object))
2156   "Creates the command line for the get-object command."
2157
2158   (format "%s %d" (call-next-method) (oref this object-id)))
2159
2160 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2161 ;;                                                                            ;;
2162 ;; Get Object                                                                 ;;
2163 ;;                                                                            ;;
2164 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2165 (defclass jde-dbs-get-object (jde-dbs-abstract-get-object) ()
2166   "Class of generic get-object commands. These commands return the fields of
2167 the object.")
2168
2169
2170 (defmethod initialize-instance ((this jde-dbs-get-object) &rest fields)
2171   "Constructor for get-object command."
2172
2173   ;; Call parent initializer.
2174   (call-next-method)
2175
2176   ;; Set command name.
2177   (oset this name "get_object"))
2178
2179 (defun jde-dbs-objectify-value (value-form)
2180   (let ((lvf        (length value-form))
2181         (value-type (car value-form)))
2182     (cond
2183      ((and (= lvf 1) (string= value-type "null"))
2184       (jde-dbs-java-null "null"))
2185      ((= lvf 2)
2186       (jde-dbs-java-primitive
2187        "primitive"
2188        :jtype  value-type
2189        :value  (nth 1 value-form)))
2190      ((= lvf 3)
2191       (if (string-match "\\[\\]" value-type)
2192           (jde-dbs-java-array
2193            (format "array %d" (nth 1 value-form))
2194            :jtype value-type
2195            :id (nth 1 value-form)
2196            :gc-flag (nth 2 value-form))
2197         (jde-dbs-java-udci
2198          (format "obj %d" (nth 1 value-form))
2199          :jtype    value-type
2200          :id       (nth 1 value-form)
2201          :gc-flag  (nth 2 value-form)))))))
2202
2203 (defun jde-dbs-objectify-variable (variable-form)
2204   (let* ((var-name   (car (car variable-form)))
2205          (var-type   (cdr (car variable-form)))
2206          (value-form (cdr variable-form))
2207          (value      (jde-dbs-objectify-value
2208                       value-form)))
2209     (jde-dbs-java-variable
2210      (format "variable %s" var-name)
2211      :name var-name
2212      :jtype (mapconcat (lambda (x) x) (nreverse var-type) " ")
2213      :value value)))
2214
2215 (defmethod jde-dbs-cmd-exec ((this jde-dbs-get-object))
2216   "Executes the get-object command. Returns a Lisp object of type
2217 `jde-dbs-java-class-instance' that represents the Java object."
2218   (let* ((process (oref this process))
2219          (result (call-next-method)))
2220     (if (jde-dbo-command-succeeded-p result)
2221         (let* ((obj     (car (jde-dbo-command-result-data result)))
2222                (type    (nth 0 obj))
2223                (id      (nth 1 obj))
2224                (gc-flag (nth 2 obj))
2225                (fields  (if (> (length obj) 3)
2226                             (nth 3 obj)))
2227                (object  (jde-dbs-java-udci
2228                          (format "obj %d" id)
2229                          :jtype type
2230                          :id id
2231                          :gc-flag gc-flag)))
2232           (if fields
2233               (mapc
2234                (lambda (variable-form)
2235                  (let ((field
2236                         (jde-dbs-objectify-variable variable-form)))
2237                    (jde-dbs-java-udci-add-field object field)))
2238                fields))
2239           object)
2240       (jde-dbs-proc-display-debug-message
2241        process
2242        (format "Error: cannot get object %d.\n Reason: %s."
2243                (oref this object-id)
2244                (car (jde-dbo-command-result-data result))))
2245       nil)))
2246
2247 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2248 ;;                                                                            ;;
2249 ;; Get String                                                                 ;;
2250 ;;                                                                            ;;
2251 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2252 (defclass jde-dbs-get-string (jde-dbs-abstract-get-object) ()
2253   "Get the value of a string object.")
2254
2255
2256 (defmethod initialize-instance ((this jde-dbs-get-string) &rest fields)
2257   "Constructor for get-string command."
2258
2259   ;; Call parent initializer.
2260   (call-next-method)
2261
2262   ;; Set command name.
2263   (oset this name "get_string"))
2264
2265 (defmethod jde-dbs-cmd-exec ((this jde-dbs-get-string))
2266   "Executes the get_string command. Returns the string."
2267   (let* ((process (oref this process))
2268          (result (call-next-method)))
2269     (if (jde-dbo-command-succeeded-p result)
2270         (nth 3 (car (jde-dbo-command-result-data result)))
2271       (jde-dbs-proc-display-debug-message
2272        process
2273        (format "Error: cannot get string %d.\n Reason: %s."
2274                (oref this object-id)
2275                (car (jde-dbo-command-result-data result))))
2276       nil)))
2277
2278 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2279 ;;                                                                            ;;
2280 ;; Get Locals                                                                 ;;
2281 ;;                                                                            ;;
2282 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2283 (defclass jde-dbs-get-locals (jde-dbs-cmd)
2284   ((thread-id         :initarg :thread-id
2285                       :type integer
2286                       :documentation
2287                       "ID of thread whose local variables are being queried.")
2288    (stack-frame-index :initarg :stack-frame-index
2289                       :type integer
2290                       :initform 0
2291                       :documentation
2292                       "Index of stack frame containing requested local variables."))
2293   "Get variables local to a specified thread and stack frame.")
2294
2295
2296 (defmethod initialize-instance ((this jde-dbs-get-locals) &rest fields)
2297   "Constructor for get-string command."
2298
2299   ;; Call parent initializer.
2300   (call-next-method)
2301
2302   (assert (slot-boundp this 'thread-id))
2303
2304   ;; Set command name.
2305   (oset this name "get_locals"))
2306
2307
2308 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-get-locals))
2309   "Creates the command line for the get-locals command."
2310   (format "%s %d %d"
2311           (call-next-method)
2312           (oref this thread-id)
2313           (oref this stack-frame-index)))
2314
2315
2316 (defmethod jde-dbs-cmd-exec ((this jde-dbs-get-locals))
2317   "Executes the get-locals command. Returns a list of Lisp objects of type
2318 `jde-dbs-java-variable' that represents the local variables."
2319   (let* ((process (oref this process))
2320          (result (call-next-method)))
2321     (if (jde-dbo-command-succeeded-p result)
2322         (let* ((variable-forms (car (jde-dbo-command-result-data result)))
2323                (variables      (if variable-forms
2324                                    (mapcar
2325                                     (lambda (variable-form)
2326                                         (jde-dbs-objectify-variable variable-form))
2327                                     variable-forms))))
2328           variables)
2329       (jde-dbs-proc-display-debug-message
2330        process
2331        (format "Error: cannot get local variables.\n Reason: %s."
2332                (car (jde-dbo-command-result-data result))))
2333       nil)))
2334
2335
2336 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2337 ;;                                                                            ;;
2338 ;; Get This                                                                   ;;
2339 ;;                                                                            ;;
2340 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2341 (defclass jde-dbs-get-this (jde-dbs-cmd)
2342   ((thread-id         :initarg :thread-id
2343                       :type integer
2344                       :documentation
2345                       "ID of thread of stack frame whose this object is required.")
2346    (stack-frame-index :initarg :stack-frame-index
2347                       :type integer
2348                       :initform 0
2349                       :documentation
2350                       "Index of stack frame whose this object is required."))
2351   "Get this object of a specified stack frame.")
2352
2353
2354 (defmethod initialize-instance ((this jde-dbs-get-this) &rest fields)
2355   "Constructor for get_this command."
2356
2357   ;; Call parent initializer.
2358   (call-next-method)
2359
2360   (assert (slot-boundp this 'process))
2361   (assert (slot-boundp this 'thread-id))
2362   (assert (slot-boundp this 'stack-frame-index))
2363
2364   ;; Set command name.
2365   (oset this name "get_this"))
2366
2367 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-get-this))
2368   "Creates the command line for the get_this command."
2369   (format "%s %d %d"
2370           (call-next-method)
2371           (oref this thread-id)
2372           (oref this stack-frame-index)))
2373
2374 (defmethod jde-dbs-cmd-success-action ((this jde-dbs-get-this))
2375   (call-next-method)
2376   (let ((this-obj (oref this :data)))
2377     (oset
2378      this
2379      :result
2380      (if (string= (nth 0 this-obj) "null")
2381          (jde-dbs-java-null "null")
2382        (jde-dbs-java-udci
2383           "this object"
2384           :jtype (nth 0 this-obj)
2385           :id (nth 1 this-obj))))))
2386
2387 (defmethod jde-dbs-cmd-failure-action ((this jde-dbs-get-this))
2388  (oset
2389   this
2390   msg
2391   (format
2392    "Error: unable to get this object for stack frame %s on thread %d.\n Reason: %s."
2393    (oref this stack-frame-index)
2394    (oref this thread-id)
2395    (oref this result))))
2396
2397
2398 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2399 ;;                                                                            ;;
2400 ;; Get Loaded Classes Command Class                                           ;;
2401 ;;                                                                            ;;
2402 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2403 (defclass jde-dbs-get-loaded-classes (jde-dbs-cmd) ()
2404   "Gets the classes loaded by a specified process.")
2405
2406 (defmethod initialize-instance ((this jde-dbs-get-loaded-classes) &rest fields)
2407   "Constructor for get_loaded_classes command."
2408
2409   ;; Call parent initializer.
2410   (call-next-method)
2411
2412   (assert (oref this process))
2413
2414   ;; Set command name.
2415   (oset this name "get_loaded_classes"))
2416
2417 (defmethod jde-dbs-cmd-exec ((this jde-dbs-get-loaded-classes))
2418   "Executes the get_loaded_classes command."
2419   (let* ((process (oref this process))
2420          (result (call-next-method)))
2421     (if (jde-dbo-command-succeeded-p result)
2422         (let ((classes (car (jde-dbo-command-result-data result))))
2423           (jde-dbs-proc-display-debug-message
2424            process
2425            (format "Loaded classes:\n  %s."
2426                    (mapconcat (lambda (x) x) classes "\n  ")) t)
2427           t)
2428       (jde-dbs-proc-display-debug-message process
2429              (format "Error: unable to list loaded classes.\n  Reason: %s."
2430                      (car (jde-dbo-command-result-data result))))
2431       nil)))
2432
2433
2434 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2435 ;;                                                                            ;;
2436 ;; Get Path Info Command Class                                                ;;
2437 ;;                                                                            ;;
2438 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2439 (defclass jde-dbs-get-path-info (jde-dbs-cmd) ()
2440   "Gets the base directory, boot classpath, and classpath of the specified process.")
2441
2442 (defmethod initialize-instance ((this jde-dbs-get-path-info) &rest fields)
2443   "Constructor for get_path_information command."
2444
2445   ;; Call parent initializer.
2446   (call-next-method)
2447
2448   (assert (oref this process))
2449
2450   ;; Set command name.
2451   (oset this name "get_path_information"))
2452
2453 (defmethod jde-dbs-cmd-exec ((this jde-dbs-get-path-info))
2454   "Executes the get_path_info command."
2455   (let* ((process (oref this process))
2456          (result (call-next-method)))
2457     (if (jde-dbo-command-succeeded-p result)
2458         (let* ((data (jde-dbo-command-result-data result))
2459                (base-dir (nth 0 data))
2460                (boot-classpath (nth 1 data))
2461                (classpath (nth 2 data)))
2462           (jde-dbs-proc-display-debug-message
2463            process
2464            (format (concat
2465                     "\nPath information\n\n  Base directory:\n    %s\n\n  "
2466                     "Boot classpath:\n    %s\n\n  Application Classpath:\n    %s\n")
2467                    base-dir
2468                    (mapconcat (lambda (x) x) boot-classpath "\n    ")
2469                    (mapconcat (lambda (x) x) classpath "\n    ")))
2470           t)
2471       (jde-dbs-proc-display-debug-message process
2472              (format "Error: unable to display path information.\n  Reason: %s."
2473                      (car (jde-dbo-command-result-data result))))
2474       nil)))
2475
2476
2477
2478 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2479 ;;                                                                            ;;
2480 ;; Get Threads                                                                ;;
2481 ;;                                                                            ;;
2482 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2483 (defclass jde-dbs-get-threads (jde-dbs-cmd) ()
2484   "Get all the threads for this process.")
2485
2486
2487 (defmethod initialize-instance ((this jde-dbs-get-threads) &rest fields)
2488   "Constructor for suspend-thread command."
2489
2490   ;; Call parent initializer.
2491   (call-next-method)
2492
2493   ;; Set command name.
2494   (oset this name "get_threads"))
2495
2496 (defun jde-dbs-map-thread-to-tree (thread)
2497   (list (quote tree-widget) :tag (concat (nth 2 thread) " thread")
2498         :value nil
2499         (list (quote tree-widget) :tag (concat "id: " (number-to-string (nth 1 thread))))
2500         (list (quote tree-widget) :tag (concat "status: " (nth 3 thread)))
2501         (list (quote tree-widget) :tag (concat "state: " (nth 4 thread)))
2502         (jde-dbs-map-stack-to-tree (nth 5 thread))))
2503
2504
2505 (defun jde-dbs-map-threadgroup-to-tree (threadgroup)
2506   (nconc
2507    (list (quote tree-widget) :tag (concat (nth 2 threadgroup) " thread group")
2508         :value nil)
2509    (mapcar
2510     (lambda (x)
2511       (jde-dbs-map-thread-to-tree x))
2512     (nth 3 threadgroup))
2513    (mapcar
2514     (lambda (x)
2515       (jde-dbs-map-threadgroup-to-tree x))
2516     (nth 4 threadgroup))))
2517
2518 (defun jde-dbs-map-stack-to-tree (stack)
2519   (nconc
2520    (list (quote tree-widget) :tag "Stack")
2521    (if (listp stack)
2522        (mapcar
2523         (lambda (x)
2524           (list (quote tree-widget) :tag
2525                 (format "%s.%s(%s:%s)" (nth 1 x) (nth 4 x) (nth 2 x)
2526                         (nth 3 x))))
2527         stack))))
2528
2529 (defun jde-dbs-map-threads-to-tree (threads)
2530   (nconc
2531    (list (quote tree-widget) :tag "Threads")
2532         (mapcar
2533          (lambda (x)
2534            (if (string= (nth 0 x) "Thread")
2535                (jde-dbs-map-thread-to-tree x)
2536              (if (string= (nth 0 x) "ThreadGroup")
2537                  (jde-dbs-map-threadgroup-to-tree x))))
2538          threads)))
2539
2540
2541 (defmethod jde-dbs-cmd-exec ((this jde-dbs-get-threads))
2542   "Executes the get-threads command. Returns a list of thread information."
2543   (let* ((process (oref this process))
2544          (result (call-next-method)))
2545     (if (jde-dbo-command-succeeded-p result)
2546         (let* ((thread-list (car (jde-dbo-command-result-data result)))
2547                (buf (oref process threads-buf)))
2548           (set-window-configuration (oref process win-cfg))
2549           (set-window-buffer
2550            (next-window
2551             (if (featurep 'xemacs)
2552                 (frame-highest-window)
2553               (frame-first-window)))
2554            buf)
2555           (set-buffer buf)
2556           (kill-all-local-variables)
2557           (let ((inhibit-read-only t))
2558             (erase-buffer))
2559           (if (not jde-xemacsp)
2560               (let ((all (overlay-lists)))
2561                 (mapcar 'delete-overlay (car all))
2562                 (mapcar 'delete-overlay (cdr all))))
2563           (apply 'widget-create (jde-dbs-map-threads-to-tree thread-list))
2564           (use-local-map widget-keymap)
2565           (widget-setup))
2566       (jde-dbs-proc-display-debug-message
2567        process
2568        (format "Error: cannot get local variables.\n Reason: %s."
2569                (car (jde-dbo-command-result-data result))))
2570       nil)))
2571
2572
2573 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2574 ;;                                                                            ;;
2575 ;; Get Thread                                                             ;;
2576 ;;                                                                            ;;
2577 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2578 (defclass jde-dbs-get-thread (jde-dbs-cmd)
2579   ((thread-id     :initarg :thread-id
2580                   :type integer
2581                   :documentation
2582                   "Id of thread to be queried."))
2583   "Gets information about a thread, including the method call stack.")
2584
2585
2586 (defmethod initialize-instance ((this jde-dbs-get-thread) &rest fields)
2587   "Constructor for suspend-thread command."
2588
2589   ;; Call parent initializer.
2590   (call-next-method)
2591
2592   (assert (slot-boundp this 'process))
2593   (assert (slot-boundp this 'thread-id))
2594
2595   ;; Set command name.
2596   (oset this name "get_thread"))
2597
2598 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-get-thread))
2599   "Creates the command line for the get_thread command."
2600   (format "%s %d" (call-next-method) (oref this thread-id)))
2601
2602 (defmethod jde-dbs-cmd-success-action ((this jde-dbs-get-thread))
2603   (call-next-method)
2604   (oset this :result (oref this :data)))
2605
2606 (defmethod jde-dbs-cmd-failure-action ((this jde-dbs-get-thread))
2607  (oset this msg (format "Error: unable to get info for thread %d.\n Reason: %s."
2608                         (oref this thread-id)
2609                         (oref this result))))
2610
2611
2612 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2613 ;;                                                                            ;;
2614 ;; Get Object Monitors                                                        ;;
2615 ;;                                                                            ;;
2616 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2617 (defclass jde-dbs-get-object-monitors (jde-dbs-cmd)
2618   ((object-id     :initarg :object-id
2619                   :type integer
2620                   :documentation
2621                   "Id of object. Required."))
2622   "Get threads that are monitoring the specified object.")
2623
2624
2625 (defmethod initialize-instance ((this jde-dbs-get-object-monitors) &rest fields)
2626   "Constructor for get_object_monitors command."
2627
2628   ;; Call parent initializer.
2629   (call-next-method)
2630
2631   (assert (slot-boundp this :object-id))
2632
2633   ;; Set command name.
2634   (oset this name "get_object_monitors"))
2635
2636 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-get-object-monitors))
2637   "Creates the command line for the get_object_monitors command."
2638
2639   (format "%s %d" (call-next-method) (oref this object-id)))
2640
2641 (defmethod jde-dbs-cmd-exec ((this jde-dbs-get-object-monitors))
2642   "Executes the get_object_monitors command."
2643   (let* ((process (oref this process))
2644          (result (call-next-method))
2645          msg)
2646     (if (jde-dbo-command-succeeded-p result)
2647         (let* ((data (car (jde-dbo-command-result-data result)))
2648                (obj-id (nth 0 data))
2649                (obj-type (nth 1 data))
2650                (obj-gc (nth 2 data))
2651                (owner (nth 3 data))
2652                (waiting (nth 4 data)))
2653
2654           (setq msg (format "\nThe following threads are monitoring <%s:%s>:\n"
2655                             obj-type obj-id))
2656
2657           (setq
2658            msg
2659            (concat
2660             msg
2661             "  Current owner:"
2662             (if (listp owner)
2663                 (concat
2664                  "\n"
2665                  "    Name:   " (nth 1 owner) "\n"
2666                  "    Id:     " (nth 2 owner) "\n"
2667                  "    Status: " (nth 3 owner) "\n"
2668                  "    State:  " (nth 4 owner) "\n")
2669               (if (stringp owner)
2670                   (concat " " owner)))))
2671
2672           (if waiting
2673               (setq
2674                msg
2675                (concat
2676                 msg
2677                 "\n  Waiting threads:"
2678                 (if (listp waiting)
2679                     (progn
2680                       "\n"
2681                       (mapconcat
2682                       (lambda (thread)
2683                         (concat
2684                          "    Name:   " (nth 1 thread) "\n"
2685                          "    Id:     " (nth 2 thread) "\n"
2686                          "    Status: " (nth 3 thread) "\n"
2687                          "    State:  " (nth 4 thread) "\n"))
2688                       waiting "\n"))
2689                   (if (stringp waiting) (concat " " waiting "\n")))))))
2690       (setq msg
2691             (format "Error: cannot get object monitors for  %d.\n Reason: %s."
2692                     (oref this object-id)
2693                     (car (jde-dbo-command-result-data result)))))
2694     (jde-dbs-proc-display-debug-message process msg)
2695     nil))
2696
2697
2698 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2699 ;;                                                                            ;;
2700 ;; Suspend Thread                                                             ;;
2701 ;;                                                                            ;;
2702 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2703 (defclass jde-dbs-suspend-thread (jde-dbs-cmd)
2704   ((thread-id     :initarg :thread-id
2705                   :type integer
2706                   :documentation
2707                   "Id of thread or thread-group to be suspended. If omitted, all threads are suspended."))
2708   "Suspend a thread of this process.")
2709
2710
2711 (defmethod initialize-instance ((this jde-dbs-suspend-thread) &rest fields)
2712   "Constructor for suspend-thread command."
2713
2714   ;; Call parent initializer.
2715   (call-next-method)
2716
2717   ;; Set command name.
2718   (oset this name "suspend"))
2719
2720 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-suspend-thread))
2721   "Creates the command line for the suspend_thread command."
2722     (if (slot-boundp this 'thread-id)
2723         (format "%s %d" (call-next-method) (oref this thread-id))
2724       (call-next-method)))
2725
2726 (defmethod jde-dbs-cmd-success-action ((this jde-dbs-suspend-thread))
2727   (call-next-method)
2728   (if (slot-boundp this 'thread-id)
2729         (oset this msg (format "Thread %d suspended." (oref this thread-id)))
2730     (oset this msg "All threads suspended.")
2731     (oset (oref this process) suspendedp t)))
2732
2733 (defmethod jde-dbs-cmd-failure-action ((this jde-dbs-suspend-thread))
2734  (oset this msg (format "Error: unable to suspend thread.\n Reason: %s."
2735                (oref this result))))
2736
2737 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2738 ;;                                                                            ;;
2739 ;; Resume Thread                                                             ;;
2740 ;;                                                                            ;;
2741 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2742 (defclass jde-dbs-resume-thread (jde-dbs-cmd)
2743   ((thread-id     :initarg :thread-id
2744                   :type integer
2745                   :documentation
2746                   "Id of thread or thread-group to be resumed. If omitted, all threads are resumed."))
2747   "Resume a thread of this process.")
2748
2749
2750 (defmethod initialize-instance ((this jde-dbs-resume-thread) &rest fields)
2751   "Constructor for resume-thread command."
2752
2753   ;; Call parent initializer.
2754   (call-next-method)
2755
2756   ;; Set command name.
2757   (oset this name "resume"))
2758
2759 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-resume-thread))
2760   "Creates the command line for the resume_thread command."
2761     (if (slot-boundp this 'thread-id)
2762         (format "%s %d" (call-next-method) (oref this thread-id))
2763       (call-next-method)))
2764
2765 (defmethod jde-dbs-cmd-success-action ((this jde-dbs-resume-thread))
2766   (call-next-method)
2767   (if (slot-boundp this 'thread-id)
2768         (oset this msg (format "Thread %d resumed." (oref this thread-id)))
2769     (oset this msg "All threads resumed.")
2770     (oset (oref this process) suspendedp nil)))
2771
2772 (defmethod jde-dbs-cmd-failure-action ((this jde-dbs-resume-thread))
2773   (oset this msg
2774         (format "Error: unable to resume thread.\n Reason: %s."
2775                 (oref this result))))
2776
2777 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2778 ;;                                                                            ;;
2779 ;; Stop Thread                                                                ;;
2780 ;;                                                                            ;;
2781 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2782 (defclass jde-dbs-stop-thread (jde-dbs-cmd)
2783   ((thread-id     :initarg :thread-id
2784                   :type integer
2785                   :documentation
2786                   "Id of thread to be stopped.")
2787    (exception-id  :initarg :exception-id
2788                   :type integer
2789                   :documentation
2790                   "Id of thread to be stopped."))
2791   "Stops the specified thread in the target process and throw the specified
2792 exception. You can use the evaluate expression command to create the exception
2793 object.")
2794
2795
2796 (defmethod initialize-instance ((this jde-dbs-stop-thread) &rest fields)
2797   "Constructor for stop-thread command."
2798
2799   ;; Call parent initializer.
2800   (call-next-method)
2801
2802  (assert (slot-boundp this 'thread-id))
2803  (assert (slot-boundp this 'exception-id))
2804
2805   ;; Set command name.
2806   (oset this name "stop"))
2807
2808 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-stop-thread))
2809   "Creates the command line for the resume_thread command."
2810
2811   (format "%s %d %d" (call-next-method) (oref this thread-id)
2812           (oref this exception-id)))
2813
2814 (defmethod jde-dbs-cmd-exec ((this jde-dbs-stop-thread))
2815   "Executes the stop_thread command."
2816   (let* ((process (oref this process))
2817          (result (call-next-method))
2818          (command-succeeded-p (jde-dbo-command-succeeded-p result)))
2819     (jde-dbs-proc-display-debug-message
2820          process
2821          (if command-succeeded-p
2822              (format "Thread %d stopped." (oref this thread-id))
2823            (format "Error: unable to stop thread %d.\n Reason: %s."
2824                    (oref this thread-id)
2825                    (car (jde-dbo-command-result-data result)))))
2826     command-succeeded-p))
2827
2828 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2829 ;;                                                                            ;;
2830 ;; Interrupt Thread                                                             ;;
2831 ;;                                                                            ;;
2832 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2833 (defclass jde-dbs-interrupt-thread (jde-dbs-cmd)
2834   ((thread-id     :initarg :thread-id
2835                   :type integer
2836                   :documentation
2837                   "Id of thread to be interrupted."))
2838   "Interrupt a thread of this process. An interrupted thread cannot be resumed.")
2839
2840
2841 (defmethod initialize-instance ((this jde-dbs-interrupt-thread) &rest fields)
2842   "Constructor for suspend-thread command."
2843
2844   ;; Call parent initializer.
2845   (call-next-method)
2846
2847  (assert (slot-boundp this 'thread-id))
2848
2849   ;; Set command name.
2850   (oset this name "interrupt"))
2851
2852 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-interrupt-thread))
2853   "Creates the command line for the interrupt_thread command."
2854   (format "%s %d" (call-next-method) (oref this thread-id)))
2855
2856 (defmethod jde-dbs-cmd-exec ((this jde-dbs-interrupt-thread))
2857   "Executes the interrupt_thread command."
2858   (let* ((process (oref this process))
2859          (result (call-next-method))
2860          (command-succeeded-p (jde-dbo-command-succeeded-p result)))
2861     (jde-dbs-proc-display-debug-message
2862          process
2863          (if command-succeeded-p
2864              (format "Thread %d interrupted." (oref this thread-id))
2865            (format "Error: unable to interrupt thread %d.\n Reason: %s."
2866                    (oref this thread-id)
2867                    (car (jde-dbo-command-result-data result)))))
2868     command-succeeded-p))
2869
2870
2871 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2872 ;;                                                                            ;;
2873 ;; Trace Methods                                                              ;;
2874 ;;                                                                            ;;
2875 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2876 (defclass jde-dbs-trace-methods (jde-dbs-cmd)
2877   ((trace-request  :initarg :trace-request
2878                    :type jde-dbs-trace-methods-request
2879                    :documentation
2880                    "Trace method request."))
2881   "Trace method entries or exits.")
2882
2883
2884 (defmethod initialize-instance ((this jde-dbs-trace-methods) &rest fields)
2885   "Constructor for trace_methods command."
2886
2887   ;; Call parent initializer.
2888   (call-next-method)
2889
2890  (assert (or
2891           (string= (oref (oref this trace-request) trace-type) "entry")
2892           (string= (oref (oref this trace-request) trace-type) "exit")))
2893
2894   ;; Set command name.
2895   (oset this name "trace_methods"))
2896
2897 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-trace-methods))
2898   "Creates the command line for the trace_methods command."
2899   (let* ((request (oref this trace-request))
2900          (cmd (format "%s %s" (call-next-method) (oref request trace-type))))
2901
2902     (if (slot-boundp request 'thread-restriction)
2903         (setq cmd (format "%s -tname %s" cmd (oref request thread-restriction))))
2904
2905     (if (slot-boundp request 'suspend-policy)
2906         (setq cmd (format "%s -sp %s" cmd (oref request suspend-policy))))
2907
2908     (if (slot-boundp request 'inclusion-filters)
2909         (setq cmd
2910               (format
2911                "%s -cf \"%s\""
2912                cmd
2913                (mapconcat (lambda (x) x) (oref request inclusion-filters) " "))))
2914
2915     (if (slot-boundp request 'exclusion-filters)
2916         (setq cmd
2917               (format
2918                "%s -cef \"%s\""
2919                cmd
2920                (mapconcat (lambda (x) x) (oref request exclusion-filters) " "))))
2921
2922     cmd))
2923
2924 (defmethod jde-dbs-cmd-exec ((this jde-dbs-trace-methods))
2925   "Executes the trace_methods command."
2926   (let* ((process (oref this process))
2927          (result (call-next-method))
2928          (command-succeeded-p (jde-dbo-command-succeeded-p result))
2929          (request (oref this trace-request))
2930          (request-id (car (jde-dbo-command-result-data result))))
2931
2932     (when command-succeeded-p
2933       (oset request id request-id)
2934       (if (slot-boundp process 'trace-req)
2935           (oset
2936            process
2937            trace-req
2938            (nconc (oref process trace-req)
2939                   (list (cons request-id request))))
2940         (oset process trace-req (list (cons request-id request)))))
2941
2942     (jde-dbs-proc-display-debug-message
2943          process
2944          (if command-succeeded-p
2945              (format "Trace method %s enabled. Use request id %s to cancel."
2946                      (oref request trace-type) request-id)
2947            (format "Error: unable to enable trace.\n Reason: %s."
2948                    (car (jde-dbo-command-result-data result)))))
2949     command-succeeded-p))
2950
2951 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2952 ;;                                                                            ;;
2953 ;; Trace Classes                                                              ;;
2954 ;;                                                                            ;;
2955 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2956 (defclass jde-dbs-trace-classes (jde-dbs-cmd)
2957   ((trace-request  :initarg :trace-request
2958                    :type jde-dbs-trace-classes-request
2959                    :documentation
2960                    "Trace classes request."))
2961   "Trace class preparations or unloadings.")
2962
2963
2964 (defmethod initialize-instance ((this jde-dbs-trace-classes) &rest fields)
2965   "Constructor for trace_classes command."
2966
2967   ;; Call parent initializer.
2968   (call-next-method)
2969
2970  (assert (or
2971           (string= (oref (oref this trace-request) trace-type) "preparation")
2972           (string= (oref (oref this trace-request) trace-type) "unloading")))
2973
2974   ;; Set command name.
2975   (oset this name "trace_classes"))
2976
2977 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-trace-classes))
2978   "Creates the command line for the trace_methods command."
2979   (let* ((request (oref this trace-request))
2980          (cmd (format "%s %s" (call-next-method) (oref request trace-type))))
2981
2982     (if (slot-boundp request 'suspend-policy)
2983         (setq cmd (format "%s -sp %s" cmd (oref request suspend-policy))))
2984
2985     (if (slot-boundp request 'inclusion-filters)
2986         (setq cmd
2987               (format
2988                "%s -cf \"%s\""
2989                cmd
2990                (mapconcat (lambda (x) x) (oref request inclusion-filters) " "))))
2991
2992     (if (slot-boundp request 'exclusion-filters)
2993         (setq cmd
2994               (format
2995                "%s -cef \"%s\""
2996                cmd
2997                (mapconcat (lambda (x) x) (oref request exclusion-filters) " "))))
2998
2999     cmd))
3000
3001 (defmethod jde-dbs-cmd-exec ((this jde-dbs-trace-classes))
3002   "Executes the trace_classes command."
3003   (let* ((process (oref this process))
3004          (result (call-next-method))
3005          (command-succeeded-p (jde-dbo-command-succeeded-p result))
3006          (request (oref this trace-request))
3007          (request-id (car (jde-dbo-command-result-data result))))
3008
3009     (when command-succeeded-p
3010       (oset request id request-id)
3011       (if (slot-boundp process 'trace-req)
3012           (oset
3013            process
3014            trace-req
3015            (nconc (oref process trace-req)
3016                   (list (cons request-id request))))
3017         (oset process trace-req (list (cons request-id request)))))
3018
3019     (jde-dbs-proc-display-debug-message
3020          process
3021          (if command-succeeded-p
3022              (format "Trace class %s enabled. Use request id %s to cancel."
3023                      (oref request trace-type) request-id)
3024            (format "Error: unable to enable trace.\n Reason: %s."
3025                    (car (jde-dbo-command-result-data result)))))
3026     command-succeeded-p))
3027
3028
3029 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3030 ;;                                                                            ;;
3031 ;; Trace Exceptions                                                           ;;
3032 ;;                                                                            ;;
3033 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3034 (defclass jde-dbs-trace-exceptions (jde-dbs-cmd)
3035   ((trace-request  :initarg :trace-request
3036                    :type jde-dbs-trace-exceptions-request
3037                    :documentation
3038                    "Trace exceptions request."))
3039   "Trace exceptions.")
3040
3041
3042 (defmethod initialize-instance ((this jde-dbs-trace-exceptions) &rest fields)
3043   "Constructor for trace_exceptions command."
3044
3045   ;; Call parent initializer.
3046   (call-next-method)
3047
3048  (assert (or
3049           (string= (oref (oref this trace-request) trace-type) "both")
3050           (string= (oref (oref this trace-request) trace-type) "caught")
3051           (string= (oref (oref this trace-request) trace-type) "uncaught")))
3052
3053   ;; Set command name.
3054   (oset this name "trace_exceptions"))
3055
3056 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-trace-exceptions))
3057   "Creates the command line for the trace_exceptions command."
3058   (let* ((request (oref this trace-request))
3059          (cmd (format "%s %s %s"
3060                       (call-next-method)
3061                       (oref request exception-class)
3062                       (oref request trace-type))))
3063
3064     (if (slot-boundp request 'suspend-policy)
3065         (setq cmd (format "%s -sp %s" cmd (oref request suspend-policy))))
3066
3067     (if (slot-boundp request 'inclusion-filters)
3068         (setq cmd
3069               (format
3070                "%s -cf \"%s\""
3071                cmd
3072                (mapconcat (lambda (x) x) (oref request inclusion-filters) " "))))
3073
3074     (if (slot-boundp request 'exclusion-filters)
3075         (setq cmd
3076               (format
3077                "%s -cef \"%s\""
3078                cmd
3079                (mapconcat (lambda (x) x) (oref request exclusion-filters) " "))))
3080
3081     cmd))
3082
3083 (defmethod jde-dbs-cmd-exec ((this jde-dbs-trace-exceptions))
3084   "Executes the trace_exceptions command."
3085   (let* ((process (oref this process))
3086          (result (call-next-method))
3087          (command-succeeded-p (jde-dbo-command-succeeded-p result))
3088          (request (oref this trace-request))
3089          (request-id (car (jde-dbo-command-result-data result))))
3090
3091     (when command-succeeded-p
3092       (oset request id request-id)
3093       (if (slot-boundp process 'trace-req)
3094           (oset
3095            process
3096            trace-req
3097            (nconc (oref process trace-req)
3098                   (list (cons request-id request))))
3099         (oset process trace-req (list (cons request-id request)))))
3100
3101     (jde-dbs-proc-display-debug-message
3102          process
3103          (if command-succeeded-p
3104              (format "Trace exception %s enabled. Use request id %s to cancel."
3105                      (oref request exception-class) request-id)
3106            (format "Error: unable to enable trace.\n Reason: %s."
3107                    (car (jde-dbo-command-result-data result)))))
3108     command-succeeded-p))
3109
3110 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3111 ;;                                                                            ;;
3112 ;; Cancel Trace Requests                                                      ;;
3113 ;;                                                                            ;;
3114 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3115 (defclass jde-dbs-cancel-trace (jde-dbs-cmd)
3116   ((trace-request  :initarg :trace-request
3117                    :type jde-dbs-trace-request
3118                    :documentation
3119                    "Trace request."))
3120   "Cancel a trace request.")
3121
3122
3123 (defmethod initialize-instance ((this jde-dbs-cancel-trace) &rest fields)
3124   "Constructor for cancel_trace command."
3125
3126   ;; Call parent initializer.
3127   (call-next-method)
3128
3129  (assert (slot-boundp this 'trace-request))
3130
3131   ;; Set command name.
3132  (oset this name (oref (oref this trace-request) cancel-command)))
3133
3134
3135 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-cancel-trace))
3136   "Creates the command line for the cancel_trace command."
3137   (format "%s %s" (call-next-method) (oref (oref this trace-request) id)))
3138
3139
3140 (defmethod jde-dbs-cmd-exec ((this jde-dbs-cancel-trace))
3141   "Executes the cancel_trace command."
3142   (let* ((process (oref this process))
3143          (result (call-next-method))
3144          (command-succeeded-p (jde-dbo-command-succeeded-p result)))
3145
3146     (if command-succeeded-p
3147         (let* ((canceled-request-id (oref (oref this trace-request) id))
3148                (requests
3149                 (remove-if
3150                  (lambda (r)
3151                    (= (car r) canceled-request-id))
3152                  (oref process trace-req))))
3153           (if requests
3154               (oset process trace-req requests)
3155             (slot-makeunbound process 'trace-req))))
3156
3157     (jde-dbs-proc-display-debug-message
3158          process
3159          (if command-succeeded-p
3160              (format "Canceled trace request %s."
3161                      (oref (oref this trace-request) id))
3162            (format "Error: unable to cancel trace %s.\n Reason: %s."
3163                    (oref (oref this trace-request) id)
3164                    (car (jde-dbo-command-result-data result)))))
3165
3166     command-succeeded-p))
3167
3168
3169 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3170 ;;                                                                            ;;
3171 ;; Watch Field                                                                ;;
3172 ;;                                                                            ;;
3173 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3174 (defclass jde-dbs-watch-field (jde-dbs-cmd)
3175   ((watch-request  :initarg :watch-request
3176                    :type jde-dbs-watch-field-request
3177                    :documentation
3178                    "Watch field request."))
3179   "Watch a field of an object or a specified class of objects.")
3180
3181
3182 (defmethod initialize-instance ((this jde-dbs-watch-field) &rest fields)
3183   "Constructor for watch field command."
3184
3185   ;; Call parent initializer.
3186   (call-next-method)
3187
3188   (let ((request (oref this watch-request)))
3189
3190     (assert (or
3191              (string= (oref request watch-type) "access")
3192              (string= (oref request watch-type) "modification")))
3193
3194     (assert (slot-boundp request 'object-class))
3195     (assert (slot-boundp request 'field-name)))
3196
3197   ;; Set command name.
3198   (oset this name "watch"))
3199
3200 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-watch-field))
3201   "Creates the command line for the watch-field command."
3202   (let* ((request (oref this watch-request))
3203          (cmd (format
3204                "%s %s %s %s"
3205                (call-next-method)
3206                (oref request object-class)
3207                (oref request field-name)
3208                (concat "for_" (oref request watch-type)))))
3209
3210     (if (slot-boundp request 'object-id)
3211         (setq cmd (format "%s -oid %s" cmd (oref request object-id))))
3212
3213     (if (slot-boundp request 'expression)
3214         (setq cmd (format "%s -if %s" cmd (oref request expression))))
3215
3216     (if (slot-boundp request 'suspend-policy)
3217         (setq cmd (format "%s -sp %s" cmd (oref request suspend-policy))))
3218
3219     (if (slot-boundp request 'inclusion-filters)
3220         (setq cmd
3221               (format
3222                "%s -cf \"%s\""
3223                cmd
3224                (mapconcat (lambda (x) x) (oref request inclusion-filters) " "))))
3225
3226     (if (slot-boundp request 'exclusion-filters)
3227         (setq cmd
3228               (format
3229                "%s -cef \"%s\""
3230                cmd
3231                (mapconcat (lambda (x) x) (oref request exclusion-filters) " "))))
3232
3233     cmd))
3234
3235 (defmethod jde-dbs-cmd-exec ((this jde-dbs-watch-field))
3236   "Executes the watch-field command."
3237   (let* ((process (oref this process))
3238          (result (call-next-method))
3239          (command-succeeded-p (jde-dbo-command-succeeded-p result))
3240          (request (oref this watch-request))
3241          (request-id (car (jde-dbo-command-result-data result))))
3242
3243     (when command-succeeded-p
3244       (oset request id request-id)
3245       (if (slot-boundp process 'watch-req)
3246           (oset
3247            process
3248            watch-req
3249            (nconc (oref process watch-req)
3250                   (list (cons request-id request))))
3251         (oset process watch-req (list (cons request-id request)))))
3252
3253     (jde-dbs-proc-display-debug-message
3254          process
3255          (if command-succeeded-p
3256              (format "Watch request field for field %s of %s instance of class %s is enabled. Use request id %s to cancel."
3257                      (oref request field-name)
3258                      (if (slot-boundp request 'object-id)
3259                          (oref request object-id)
3260                        "any")
3261                      (oref request object-class)
3262                      request-id)
3263            (format "Error: unable to enable watch request.\n Reason: %s."
3264                    (car (jde-dbo-command-result-data result)))))
3265     command-succeeded-p))
3266
3267
3268 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3269 ;;                                                                            ;;
3270 ;; Cancel Watch Requests                                                      ;;
3271 ;;                                                                            ;;
3272 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3273 (defclass jde-dbs-cancel-watch (jde-dbs-cmd)
3274   ((watch-request  :initarg :watch-request
3275                    :type jde-dbs-watch-field-request
3276                    :documentation
3277                    "Watch request."))
3278   "Cancel a watch request.")
3279
3280
3281 (defmethod initialize-instance ((this jde-dbs-cancel-watch) &rest fields)
3282   "Constructor for cancel_watch command."
3283
3284   ;; Call parent initializer.
3285   (call-next-method)
3286
3287  (assert (slot-boundp this 'watch-request))
3288
3289   ;; Set command name.
3290  (oset this name "clear"))
3291
3292
3293 (defmethod jde-dbs-cmd-make-command-line ((this jde-dbs-cancel-watch))
3294   "Creates the command line for the clear command."
3295   (format "%s %s" (call-next-method) (oref (oref this watch-request) id)))
3296
3297
3298 (defmethod jde-dbs-cmd-exec ((this jde-dbs-cancel-watch))
3299   "Executes the cancel watch command."
3300   (let* ((process (oref this process))
3301          (result (call-next-method))
3302          (command-succeeded-p (jde-dbo-command-succeeded-p result)))
3303
3304     (if command-succeeded-p
3305         (let* ((canceled-request-id (oref (oref this watch-request) id))
3306                (requests
3307                 (remove-if
3308                  (lambda (r)
3309                    (= (car r) canceled-request-id))
3310                  (oref process watch-req))))
3311           (if requests
3312               (oset process watch-req requests)
3313             (slot-makeunbound process 'watch-req))))
3314
3315     (jde-dbs-proc-display-debug-message
3316          process
3317          (if command-succeeded-p
3318              (format "Canceled watch request %s."
3319                      (oref (oref this watch-request) id))
3320            (format "Error: unable to cancel watch request %s.\n Reason: %s."
3321                    (oref (oref this watch-request) id)
3322                    (car (jde-dbo-command-result-data result)))))
3323
3324     command-succeeded-p))
3325
3326
3327 (eval-when-compile
3328   ;; This code will not appear in the compiled (.elc) file
3329   (defun jde-dbs-self-test ()
3330     "Runs jde-dbs self tests."
3331     (interactive)
3332     (apply 'regress
3333            (list test-jde-dbs-proc))))
3334
3335
3336 (provide 'jde-dbs)
3337
3338 ; $Log: jde-dbs.el,v $
3339 ; Revision 1.101  2005/01/18 05:23:31  paulk
3340 ; Change variables named assoc to assoc-x. This is intended to fix a "Symbol's value as variable is void: old-assoc" problem when debugging with the compiled version of JDE in xemacs/cygwin. Thanks to Henry S. Thompson.
3341 ;
3342 ; Revision 1.100  2004/10/18 02:54:46  paulk
3343 ; Added self test.
3344 ;
3345 ; Revision 1.99  2004/10/16 04:55:56  paulk
3346 ; Fix regression caused by refactoring.
3347 ;
3348 ; Revision 1.98  2004/10/09 05:26:21  paulk
3349 ; Fix Emacs interface to JDEbug so that it handles chunked responses to debugger commands.
3350 ;
3351 ; Revision 1.97  2004/06/03 02:05:47  paulk
3352 ; jde-require tree-widget.
3353 ;
3354 ; Revision 1.96  2004/04/29 02:42:33  paulk
3355 ; Fix regression in jdb interface. Thanks to Jack Donohue.
3356 ;
3357 ; Revision 1.95  2003/05/06 05:25:05  ahyatt
3358 ; Removing last checkin, which was a mistake
3359 ;
3360 ; Revision 1.94  2003/05/06 04:50:07  ahyatt
3361 ; Fixed problem with package variable, and the function to recursively delete a directory.
3362 ;
3363 ; Revision 1.93  2003/03/28 05:33:29  andyp
3364 ; XEmacs optimizations for JDEbug and efc.
3365 ;
3366 ; Revision 1.92  2003/02/25 06:53:29  paulk
3367 ; Created a generalized jde-debug command and wired it up to jdb.
3368 ; Next step is to wire it up to JDEbug.
3369 ;
3370 ; Revision 1.91  2002/12/06 03:47:35  ahyatt
3371 ; Changes to support Mac OS X, which does not use tools.jar
3372 ;
3373 ; Revision 1.90  2002/09/26 03:55:28  paulk
3374 ; XEmacs compatibility fix: the JDEBUG get threads command now invokes
3375 ; frame-highest-window instead of frame-first-window on XEmacs.
3376 ; Thanks to Michael Duvigneau.
3377 ;
3378 ; Revision 1.89  2002/06/12 07:04:26  paulk
3379 ; XEmacs compatibility fix: set win32-quote-process-args wherever
3380 ; the JDEE sets w32-quote-process-args. This allows use of spaces in
3381 ; paths passed as arguments to processes (e.g., javac)  started by
3382 ; the JDEE.
3383 ;
3384 ; Revision 1.88  2002/06/11 06:38:50  paulk
3385 ; Provides support for paths containing spaces as JDEbug vm arguments via the following change:
3386 ; locally set the w32-quote-process-args variable to a quotation mark when launching
3387 ; the JDEbug vm process.
3388 ;
3389 ; Revision 1.87  2002/01/16 07:34:36  paulk
3390 ; Updated JDEbug to use most of the new generalized breakpoint functionality.
3391 ;
3392 ; Revision 1.86  2001/12/10 04:29:55  paulk
3393 ; Created generalized breakpoint framework. Provided initial
3394 ; implementation for jdb. A lot of work remains.
3395 ;
3396 ; Revision 1.85  2001/12/07 12:31:24  jslopez
3397 ; Fixes bug that will cause the the display loaded classes command
3398 ; to dump the information into the *Messages* buffer.
3399 ;
3400 ; Revision 1.84  2001/12/04 05:30:12  paulk
3401 ; Updated to reflect change in dialog class package name prefix from jde- to efc-.
3402 ;
3403 ; Revision 1.83  2001/11/29 11:14:35  paulk
3404 ; * Fixed many references to undefined variables that were generating compiler warning messages.
3405 ;
3406 ; * Removed obsolete function jde-dbs-listen-for-debugger-socket.
3407 ;
3408 ; Revision 1.82  2001/11/26 06:26:54  paulk
3409 ; Replaced jde-bug-jdk-directory with a call to jde-get-jdk-dir.
3410 ;
3411 ; Revision 1.81  2001/11/18 19:26:04  jslopez
3412 ; Modifies jde-dbs-proc-display-debug-message
3413 ; to take an additional argument to pop the buffer.
3414 ; The idea is to show the message in the minibuffer whenever
3415 ; the Process buffer is not showing up, and for methods like display
3416 ; variables be able to bring the buffer up.
3417 ;
3418 ; Revision 1.80  2001/11/18 17:47:16  jslopez
3419 ; Modifies jde-dbs-proc-display-debug-message
3420 ; to pop the buffer when it is not showing.
3421 ;
3422 ; Revision 1.79  2001/11/18 14:57:18  jslopez
3423 ; Fixes bug caused when trying to display empty
3424 ; arrays.
3425 ;
3426 ; Revision 1.78  2001/11/13 05:36:29  paulk
3427 ; Changed jde-dbs-debugger-start to use expand-file-name instead of
3428 ; concat to build JDE java path.
3429 ;
3430 ; Revision 1.77  2001/10/24 20:22:57  jslopez
3431 ; Removed the obsolete method jde-dbs-choose-vm
3432 ; Updated the old call to jde-dbs-choose-vm for
3433 ; a call to jde-run-get-vm.
3434 ;
3435 ; Revision 1.76  2001/10/01 17:37:13  jslopez
3436 ; Fixed make error:
3437 ; While compiling toplevel forms in file c:/cygwin/home/jslopez/emacs-20.7/site-lisp/jde/lisp/jde-bug.el:
3438 ;   !! Symbol's function definition is void ((mapc))
3439 ;
3440 ; Revision 1.75  2001/10/01 12:11:15  paulk
3441 ; Now requires jde-db.
3442 ;
3443 ; Revision 1.74  2001/09/29 04:38:15  paulk
3444 ; Correct cut-and-paste error.
3445 ;
3446 ; Revision 1.73  2001/09/28 04:52:17  paulk
3447 ; Made jde-db-debugger the root class for jde-dbs-debugger.
3448 ;
3449 ; Revision 1.72  2001/09/07 14:24:44  jslopez
3450 ; Remove splitting the frame in 3 windows when the debugger is enable.
3451 ;
3452 ; Revision 1.71  2001/06/05 06:34:36  paulk
3453 ; Fixed bug in jde-dbs-proc-set-find.
3454 ;
3455 ; Revision 1.70  2001/05/23 03:35:56  paulk
3456 ; Supplied missing :documentation keywords in jde-dbs-cmd. Thanks to David Ponce.
3457 ;
3458 ; Revision 1.69  2001/05/19 02:30:25  paulk
3459 ; JDEbug now reinitializes various variables whenever you start a debug session.
3460 ; Previously restarting JDEbug after certain errors, for example, failure to launch
3461 ; a process, would require restarting Emacs.
3462 ;
3463 ; Revision 1.68  2001/04/19 04:34:53  paulk
3464 ; -- Converted local variables and thread buffers to use David Ponce's tree-widget.
3465 ;
3466 ; -- Fixed backslash bug in jde-dbs-extract-lisp-form.
3467 ;
3468 ; Revision 1.67  2001/04/16 05:51:29  paulk
3469 ; Normalized paths. Thanks to Nick Sieger.
3470 ;
3471 ; Revision 1.66  2001/04/12 04:40:15  paulk
3472 ; Normalize jde-run-working-directory.
3473 ;
3474 ; Revision 1.65  2001/04/02 02:47:19  paulk
3475 ; Removed commented out function.
3476 ;
3477 ; Revision 1.64  2001/03/28 12:45:33  paulk
3478 ; Fixed jde-dbs-debugger-start to use new centralized jde-build-classpath function.
3479 ;
3480 ; Revision 1.63  2001/01/23 07:37:43  paulk
3481 ; Removed typo from jde-dbs-proc-set-find.
3482 ;
3483 ; Revision 1.62  2001/01/06 05:11:57  paulk
3484 ; Fixed regression bug caused by reimplementation of the cygpath conversion function.
3485 ;
3486 ; Revision 1.61  2000/12/18 05:22:45  paulk
3487 ; *** empty log message ***
3488 ;
3489 ; Revision 1.60  2000/10/25 03:04:42  paulk
3490 ; Added a new variable, jde-bug-sio-connect-delay.
3491 ;
3492 ;   This variable specifies the length of time in seconds
3493 ;   that the JDE waits before attempting to connect to the
3494 ;   debuggee application's standard I/O. This delay
3495 ;   is intended to give JDEbug time to create the
3496 ;   SIO socket. Previously, the JDE would attempt to
3497 ;   connect immediately, possibly before JDEbug had time
3498 ;   to create a socket for the standard I/O. This might
3499 ;   explain the launch command timeout failures that some users have
3500 ;   experienced, especially on Windows/NT.
3501 ;
3502 ; Revision 1.59  2000/09/21 02:27:55  paulk
3503 ; Now include jde-run.el when compiling to get the definition for save-w32-show-window macro.
3504 ;
3505 ; Revision 1.58  2000/09/05 04:58:14  paulk
3506 ; Fixed jde-dbs-debugger-display-message.
3507 ;
3508 ; Revision 1.57  2000/08/14 02:31:57  paulk
3509 ; Adds support for Step Into All command.
3510 ;
3511 ; Revision 1.56  2000/07/28 06:27:45  paulk
3512 ; Committing all modified files.
3513 ;
3514 ; Revision 1.55  2000/06/12 08:35:38  paulk
3515 ; Now uses the value of jde-bug-debugger-host-address as the address of the socket for the CLI channel.
3516 ;
3517 ; Revision 1.54  2000/04/23 06:19:29  paulk
3518 ; Fixed some problems with the process launch command. Among others,
3519 ; the command now uses `system-name', instead of an absolute
3520 ; address (127.0.0.1) to refer to the local host when connecting to
3521 ; the port used to transport the debuggee process's standard I/O.
3522 ; This fixes the failure to start processes that occurs on some
3523 ; Windows networks.
3524 ;
3525 ; Revision 1.53  2000/04/18 01:20:52  paulk
3526 ; Fixes a bug in the jde-dbs-cmd-failure-action method for jde-dbs-get-this and a bug in the jde-dbs-cmd-success-action for jde-dbs-listen-for process.
3527 ;
3528 ; Revision 1.52  2000/04/13 09:20:54  paulk
3529 ; Removed one stray reference to deleted function jde-proc-steppable-p.
3530 ;
3531 ; Revision 1.51  2000/04/13 09:00:09  paulk
3532 ; Added steppablep field to process object. Set whenever process hits a breakpoint or step event.
3533 ; Modified jde-dbs-target-process-steppable-p to test steppablep field.
3534 ; This fixes menu enabling bug.
3535 ; Debugger lisp output parser now suspends paren balancing in strings. This fixes Lisp eval error when a Java variable includes unbalanced parentheses.
3536 ;
3537 ; Revision 1.50  2000/04/10 05:22:55  paulk
3538 ; Added command to get the this object for a specified stack frame.
3539 ;
3540 ; Revision 1.49  2000/04/05 05:00:02  paulk
3541 ; Fixed thread-tree code to ignore No information Available threads.
3542 ;
3543 ; Revision 1.48  2000/03/27 07:31:54  paulk
3544 ; Now sets the working directory to jde-run-working-directory (if not null) before starting the debugger.
3545 ;
3546 ; Revision 1.47  2000/03/17 04:19:02  paulk
3547 ; Display threads now includes the stack for each thread. Thanks to Paul Michael Reilly <pmr@pajato.com> for implementing this.
3548 ;
3549 ; Revision 1.46  2000/03/16 05:05:06  paulk
3550 ; Enabled interactive reading of vm and application arguments for JDEbug sessions. Thanks to Steve Haflich <smh@franz.com> for this enhancement.
3551 ;
3552 ; Revision 1.45  2000/02/17 06:36:31  paulk
3553 ; Fixed scrolling in process debug message window. Thanks to "Martin
3554 ; Dickau" <mdickau@byallaccounts.com> for this fix.
3555 ;
3556 ; Revision 1.44  2000/02/17 06:23:44  paulk
3557 ; jde-dbs-cmd now copies and then empties the pending event queue before
3558 ; processing the events. This fixes an infinite recursion bug that can
3559 ; occur when stepping through code.
3560 ;
3561 ; Revision 1.43  2000/02/16 04:41:41  paulk
3562 ; Implemented Cygwin/XEmacs compatiblity fixes provided by Fred Hart
3563 ; <cfhart@Z-TEL.com>.
3564 ;
3565 ; Revision 1.42  2000/02/14 06:19:37  paulk
3566 ; Implemented up and down stack commands.
3567 ;
3568 ; Revision 1.41  2000/02/10 02:53:38  paulk
3569 ; Fixed bug where Display->Threads command was not enabled when debugger
3570 ; was attached to a process.
3571 ;
3572 ; Revision 1.40  2000/02/01 05:59:54  paulk
3573 ; Added commands for listening for applications needing debug services.
3574 ;
3575 ; Revision 1.39  2000/02/01 04:11:55  paulk
3576 ; ReleaseNotes.txt
3577 ;
3578 ; Revision 1.38  2000/01/17 09:36:39  paulk
3579 ; Implemented array and object inspectors.
3580 ;
3581 ; Revision 1.37  2000/01/15 08:04:08  paulk
3582 ; Added show buffer commands.
3583 ;
3584 ; Revision 1.36  2000/01/02 08:07:55  paulk
3585 ; Added attach process commands.
3586 ;
3587 ; Revision 1.35  1999/12/27 08:01:17  paulk
3588 ; Added show object monitors command.
3589 ;
3590 ; Revision 1.34  1999/12/20 07:52:06  paulk
3591 ; Added cancel watchpoint command.
3592 ;
3593 ; Revision 1.33  1999/12/19 06:54:21  paulk
3594 ; Added watch field command.
3595 ;
3596 ; Revision 1.32  1999/12/14 04:46:02  paulk
3597 ; Added JDEbug->Processes->Remove Dead Processes command.
3598 ;
3599 ; Revision 1.31  1999/12/13 05:54:08  paulk
3600 ; Added jde-bug-vm-executable and jde-bug-jre-home variables.
3601 ; Fixed jde-dbs-launch-process command so that it fails gracefully.
3602 ;
3603 ; Revision 1.30  1999/12/03 08:22:00  paulk
3604 ; Updated JDEbug to run under JDK 1.3beta.
3605 ;
3606 ; Revision 1.29  1999/11/30 05:46:22  paulk
3607 ; Added JDEbug->Display->Path Info command.
3608 ;
3609 ; Revision 1.28  1999/11/29 06:58:41  paulk
3610 ; Added JDEbug->Display->Loaded Classes Command.
3611 ;
3612 ; Revision 1.27  1999/11/27 05:13:49  paulk
3613 ; Added commands for tracing classes.
3614 ;
3615 ; Revision 1.26  1999/11/23 06:37:04  paulk
3616 ; Added Trace->Cancel command.
3617 ;
3618 ; Revision 1.25  1999/11/16 05:58:17  paulk
3619 ; Added trace method commands and skeletons for trace class and cancel
3620 ; trace commands.
3621 ;
3622 ; Revision 1.24  1999/11/04 05:52:42  paulk
3623 ; Added trace-mode fields to jde-dbs-proc class. Needed to support trace mode.
3624 ; Added object-refs field to jde-dbs-proc class. Needed to support object reference management.
3625 ;
3626 ; Revision 1.23  1999/10/28 04:18:09  paulk
3627 ; Added interrupt and stop thread commands.
3628 ;
3629 ; Revision 1.22  1999/10/14 04:59:23  paulk
3630 ; Added Resume Process and Resume Thread commands.
3631 ;
3632 ; Revision 1.21  1999/10/13 08:16:43  paulk
3633 ; Added suspend process and suspend thread commands.
3634 ;
3635 ; Revision 1.20  1999/10/13 06:19:00  paulk
3636 ; Add JDEBug->Show Threads command
3637 ;
3638 ; Revision 1.19  1999/09/28 04:12:50  paulk
3639 ; start debugger method now checks whether debugger actually started
3640 ; and returns nil if the debugger did not start.
3641 ;
3642 ; Revision 1.18  1999/09/18 03:55:58  paulk
3643 ; Fixed bug in the launch-process command where the command was failing
3644 ; to convert the application arguments from a list of arguments to a
3645 ; string of arguments. Thanks to "Matthew
3646 ; Weymar"<mweymar@hamilton-partners.com> for reporting the bug.
3647 ;
3648 ; Revision 1.17  1999/09/16 05:36:59  paulk
3649 ; Added get locals command.
3650 ;
3651 ; Revision 1.16  1999/09/13 05:37:33  paulk
3652 ; Enhanced get array command.
3653 ;
3654 ; Revision 1.15  1999/09/10 06:41:50  paulk
3655 ; Finished first cut at get_object command.
3656 ;
3657 ; Revision 1.14  1999/09/08 05:40:46  paulk
3658 ; Updated debugger code to take advantage of new unbound slot capability
3659 ; of eieio.
3660 ;
3661 ; Revision 1.13  1999/09/07 05:12:36  paulk
3662 ; Added get array command.
3663 ;
3664 ; Revision 1.12  1999/09/05 04:35:34  paulk
3665 ; Added initial implementation of evaluate and display variable commands.
3666 ;
3667 ; Revision 1.11  1999/08/30 07:10:41  paulk
3668 ; Converted clear breakpoint command to OOPS.
3669 ;
3670 ; Revision 1.10  1999/08/28 05:34:20  paulk
3671 ; Improved multiple process handling, window configuration.
3672 ;
3673 ; Revision 1.9  1999/08/27 05:27:53  paulk
3674 ; Provided initial support for multiple processes.
3675 ; Fixed jde-find-data-directory to work on XEmacs with a standard
3676 ; JDE distribution.
3677 ; Ported breakpoint highlighting code to XEmacs. Still has bugs though.
3678 ; Now includes jde-db-option options on vm command-line for process.
3679 ;
3680 ; Revision 1.8  1999/08/24 06:29:43  paulk
3681 ; Reimplemented the constructor for jde-dbs-proc the right way. Renamed
3682 ; jde-bug-counter to jde-bug-breakpoint-counter.
3683 ;
3684 ; Revision 1.7  1999/08/24 03:26:39  paulk
3685 ; Fixed a couple of NT-related problems. In particular, add an extra
3686 ; line feed after debugger commands to force flushing of debugger output
3687 ; buffer and modified jde-dbs-process-runnable-p to recognize an
3688 ; "unknown" state as runnable if the process is suspended.
3689 ;
3690
3691 ;; End of jde-dbs.el