cgit.sxemacs.org Git - packages/blob - xemacs-packages/ilisp/ild.el

   1 ;;; -*- Mode: Emacs-Lisp -*-
   2
   3 ;;; ILD: A common Common Lisp debugger user interface for ILisp.
   4 ;;;   ---Jeffrey Mark Siskind
   5
   6 ;;; This file is part of ILISP.
   7 ;;; Please refer to the file COPYING for copyrights and licensing
   8 ;;; information.
   9 ;;; Please refer to the file ACKNOWLEGDEMENTS for an (incomplete) list
  10 ;;; of present and past contributors.
  11 ;;;
  12 ;;; $Id: ild.el,v 1.3 2002-06-03 23:36:58 wbd Exp $
  13
  14 ;;; Keystroke c-u? What it does
  15 ;;; ---------------------------------------------------------
  16 ;;; m-a            Abort
  17 ;;; m-c            Continue
  18 ;;; c-m-n     *    Next stack frame
  19 ;;; c-m-p     *    Previous stack frame
  20 ;;; c-c <          Top stack frame
  21 ;;; c-c >          Bottom stack frame
  22 ;;; m-b            Backtrace
  23 ;;; c-m-d          Display all locals
  24 ;;; c-m-l     *    Display particular local
  25 ;;; c-c r          Return
  26 ;;; c-m-r          Retry
  27 ;;; c-x t          Trap on exit
  28 ;;; c-c L          Select Lisp interaction buffer
  29 ;;; c-z c-s        Sets compiler options for maximally debuggablity
  30 ;;; c-z c-f        Sets compiler options for fastest but least debuggable code
  31
  32 ;;; Dependencies
  33 ;;; We really just need ILISP Key management.
  34 ;;; 19990615 Marco Antoniotti
  35
  36 ;;; (require 'ilisp)
  37 (require 'ilisp-key)
  38
  39 (deflocal ild-abort-string nil)
  40 (deflocal ild-continue-string nil)
  41 (deflocal ild-step-string nil)
  42 (deflocal ild-step-string-arg nil)
  43 (deflocal ild-next-string nil)
  44 (deflocal ild-next-string-arg nil)
  45 (deflocal ild-previous-string nil)
  46 (deflocal ild-previous-string-arg nil)
  47 (deflocal ild-top-string nil)
  48 (deflocal ild-bottom-string nil)
  49 (deflocal ild-backtrace-string nil)
  50 (deflocal ild-locals-string nil)
  51 (deflocal ild-local-string-arg nil)
  52 (deflocal ild-return-string nil)
  53 (deflocal ild-retry-string nil)
  54 (deflocal ild-trap-on-exit-string nil)
  55
  56 (defun ild-debugger-command (string)
  57  (process-send-string (get-buffer-process (current-buffer))
  58                       (format "%s\n" string)))
  59
  60 (defun ild-prompt ()
  61  (save-excursion
  62   (beginning-of-line)
  63   (comint-skip-prompt)
  64   (eobp)))
  65
  66 (defun ild-abort ()
  67  (interactive)
  68  (if ild-abort-string
  69      (ild-debugger-command ild-abort-string)
  70      (beep)))
  71
  72 (defun ild-continue (&optional arg)
  73  (interactive "P")
  74  (if (ild-prompt)
  75      (if ild-continue-string
  76          (ild-debugger-command ild-continue-string)
  77          (beep))
  78      (if arg (capitalize-word arg) (capitalize-word 1))))
  79
  80 (defun ild-step (&optional arg)
  81  (interactive "P")
  82  (if arg
  83      (if ild-step-string-arg
  84          (ild-debugger-command (format ild-step-string-arg arg))
  85          (beep))
  86      (if ild-step-string
  87          (ild-debugger-command ild-step-string)
  88          (beep))))
  89
  90 (defun ild-next (&optional arg)
  91  (interactive "P")
  92  (if arg
  93      (if ild-next-string-arg
  94          (ild-debugger-command (format ild-next-string-arg arg))
  95          (beep))
  96      (if ild-next-string
  97          (ild-debugger-command ild-next-string)
  98          (beep))))
  99
 100 (defun ild-previous (&optional arg)
 101  (interactive "P")
 102  (if arg
 103      (if ild-previous-string-arg
 104          (ild-debugger-command (format ild-previous-string-arg arg))
 105          (beep))
 106      (if ild-previous-string
 107          (ild-debugger-command ild-previous-string)
 108          (beep))))
 109
 110 (defun ild-top (&optional arg)
 111  (interactive "P")
 112  (if ild-top-string
 113      (ild-debugger-command ild-top-string)
 114      (beep)))
 115
 116 (defun ild-bottom (&optional arg)
 117  (interactive "P")
 118  (if ild-bottom-string
 119      (ild-debugger-command ild-bottom-string)
 120      (beep)))
 121
 122 (defun ild-backtrace (&optional arg)
 123  (interactive "P")
 124  (if (ild-prompt)
 125      (if ild-backtrace-string
 126          (ild-debugger-command ild-backtrace-string)
 127          (beep))
 128      (if arg (backward-word arg) (backward-word 1))))
 129
 130 (defun ild-locals (&optional arg)
 131  (interactive "P")
 132  (if ild-locals-string
 133      (ild-debugger-command ild-locals-string)
 134      (beep)))
 135
 136 (defun ild-local (&optional arg)
 137  (interactive "P")
 138  (if arg
 139      (if ild-local-string-arg
 140          (ild-debugger-command (format ild-local-string-arg arg))
 141          (beep))
 142      (if ild-locals-string
 143          (ild-debugger-command ild-locals-string)
 144          (beep))))
 145
 146 (defun ild-return ()
 147  (interactive)
 148  (if ild-return-string
 149      (ild-debugger-command ild-return-string)
 150      (beep)))
 151
 152 (defun ild-retry ()
 153  (interactive)
 154  (if ild-retry-string
 155      (ild-debugger-command ild-retry-string)
 156      (beep)))
 157
 158 (defun ild-trap-on-exit (&optional arg)
 159  (interactive "P")
 160  (if ild-trap-on-exit-string
 161      (ild-debugger-command ild-trap-on-exit-string)
 162      (beep)))
 163
 164 (defun fast-lisp ()
 165  "Use the production compiler."
 166  (interactive)
 167  (ilisp-send "(progn (proclaim '(optimize (speed 3) (safety 0) (space 0) (compilation-speed 0) (debug 0))) #+akcl (use-fast-links t))"))
 168
 169 (defun slow-lisp ()
 170  "Use the development compiler."
 171  (interactive)
 172  (ilisp-send "(progn (proclaim '(optimize (speed 0) (safety 3) (space 3) (compilation-speed 3) (debug 3))) #+akcl (use-fast-links nil))"))
 173
 174 (defun select-lisp ()
 175   "Select the lisp buffer in one window mode"
 176   (interactive)
 177   (cond ((and (member* ilisp-buffer (buffer-list)
 178                        :key #'buffer-name
 179                        :test #'equal)
 180               (get-buffer-process (get-buffer ilisp-buffer)))
 181          (delete-other-windows)
 182          (switch-to-buffer ilisp-buffer))
 183         (t (lucid)                      ; put your favorite Lisp here
 184            (delete-other-windows))))
 185
 186 (defun select-ilisp (arg)
 187   "Select the current ILISP buffer."
 188   (interactive "P")
 189   (when (and (not arg)
 190              (member* (buffer-name (current-buffer)) ilisp-buffers
 191                       :test (function (lambda (x y)
 192                                         (equal x (format "*%s*" (car y)))))))
 193     (setq ilisp-buffer (buffer-name (current-buffer)))
 194     (let ((new (completing-read
 195                 (if ilisp-buffer
 196                     (format "Buffer [%s]: "
 197                             (substring ilisp-buffer
 198                                        1
 199                                        (1- (length ilisp-buffer))))
 200                   "Buffer: ")
 201                 ilisp-buffers nil t)))
 202       (unless (zerop (length new))
 203         (setq ilisp-buffer (format "*%s*" new))))))
 204
 205 ;;; This fixes a bug in ILISP 4.1
 206 ;;;
 207 ;;; Note:
 208 ;;; 19990818 Marco Antoniotti
 209 ;;; Fixed in the proper place.
 210
 211 ;(defun defkey-ilisp (key command &optional inferior-only)
 212 ; "Define KEY as COMMAND in ilisp-mode-map and lisp-mode-map unless
 213 ;optional INFERIOR-ONLY is T.  If the maps do not exist they will be
 214 ;created.  This should only be called after ilisp-prefix is set to the
 215 ;desired prefix."
 216 ; (if (not ilisp-mode-map) (ilisp-bindings))
 217 ; (define-key ilisp-mode-map key command)
 218 ; (if (not inferior-only) (define-key lisp-mode-map key command)))
 219
 220 ;;; This is a convenient command since c-Z c-W doesn't default to the whole
 221 ;;; buffer if there is no region
 222
 223 (defun compile-buffer ()
 224  "Compile the current buffer"
 225  (interactive)
 226  (compile-region-and-go-lisp (point-min) (point-max)))
 227
 228 (defkey-ilisp "\M-a"    'ild-abort         t  'no-fsf-key)
 229 (defkey-ilisp "\M-c"    'ild-continue      t  'no-fsf-key)
 230 (defkey-ilisp "\C-\M-s" 'ild-step          t  'no-fsf-key)
 231 (defkey-ilisp "\C-\M-n" 'ild-next          t  'no-fsf-key)
 232 (defkey-ilisp "\C-\M-p" 'ild-previous      t  'no-fsf-key)
 233 (defkey-ilisp "\C-c<"   'ild-top           t  'no-fsf-key)
 234 (defkey-ilisp "\C-c>"   'ild-bottom        t  'no-fsf-key)
 235 (defkey-ilisp "\M-b"    'ild-backtrace     t  'no-fsf-key)
 236 (defkey-ilisp "\C-\M-d" 'ild-locals        t  'no-fsf-key)
 237 (defkey-ilisp "\C-\M-l" 'ild-local         t  'no-fsf-key)
 238 (defkey-ilisp "\C-cr"   'ild-return        t  'no-fsf-key)
 239 (defkey-ilisp "\C-\M-r" 'ild-retry         t  'no-fsf-key)
 240 (defkey-ilisp "\C-xt"   'ild-trap-on-exit  t  'no-fsf-key)
 241
 242 (ilisp-safe-define-key global-map "\C-cL" 'select-lisp 'no-fsf-key)
 243
 244 (ilisp-bind-ilisp-key-for-map lisp-mode-map  "\C-f" 'fast-lisp 'no-fsf-key)
 245 (ilisp-bind-ilisp-key-for-map ilisp-mode-map "\C-f" 'fast-lisp 'no-fsf-key)
 246 (ilisp-bind-ilisp-key-for-map lisp-mode-map  "\C-s" 'slow-lisp 'no-fsf-key)
 247 (ilisp-bind-ilisp-key-for-map ilisp-mode-map "\C-s" 'slow-lisp 'no-fsf-key)
 248
 249 ;;; end of file -- ild.el --