src/lsp/oldstep.lsp

   1 ;;;; XLISP-STAT 2.1 Copyright (c) 1990, by Luke Tierney
   2 ;;;; Additions to Xlisp 2.1, Copyright (c) 1989 by David Michael Betz
   3 ;;;; You may give out copies of this software; for conditions see the file
   4 ;;;; COPYING included with this distribution.
   5
   6 (defun step (expr)
   7   (let ((hooklevel 0)
   8         (option nil)
   9         #+macintosh (dialog (step-dialog))
  10         (help-string "~%:b - break~%:h - help (this message)~%:n - next~%:s - skip~%:e - evaluate~%"))
  11     (labels ((indent () (terpri) (dotimes (i (* 2 hooklevel)) (princ " ")))
  12              (read-option (env)
  13                           (loop (princ " ? ")
  14                                 (let ((c (read)))
  15                                   (cond
  16                                     ((member c '(:s :n :b)) (return c))
  17                                     ((equal c :h) (format t help-string))
  18                                     ((equal c :e)
  19                                      (print (evalhook (read)
  20                                                       nil
  21                                                       nil
  22                                                       env)))))))
  23              (trace-hook-function       (expr &optional env)
  24                (setq hooklevel (1+ hooklevel))
  25                (indent)
  26                (format t        "Form:   ~s" expr)
  27                (force-output)
  28                (let ((value (evalhook expr
  29                                       #'trace-hook-function
  30                                       nil
  31                                       env)))
  32                  (indent)
  33                  (format t      "Value:  ~s" value)
  34                  (force-output)
  35                  (setq hooklevel (1- hooklevel))
  36                  value))
  37              (step-hook-function (expr &optional env)
  38                (setq hooklevel (1+ hooklevel))
  39                (indent)
  40                (format t        "Form:   ~s" expr)
  41                (force-output)
  42                (setq option (if (atom expr) nil (read-option env)))
  43                (if (equal option :b) (break))
  44                (let ((value (evalhook expr
  45                                       (if (equal option :s)
  46                                           nil ;#'trace-hook-function
  47                                           #'step-hook-function)
  48                                       nil
  49                                       env)))
  50                  (indent)
  51                  (format t      "Value:  ~s" value)
  52                  (force-output)
  53                  (setq hooklevel (1- hooklevel))
  54                  value)))
  55     (unwind-protect (step-hook-function expr)
  56                     (terpri)
  57 #+macintosh         (send dialog :remove)))))
  58
  59 (defun step-dialog ()
  60   (let* ((text-item (send text-item-proto :new "                           "
  61                            :editable t)))
  62     (send dialog-proto :new
  63           (list text-item
  64                 (send button-item-proto :new "Eval"
  65                       :action
  66                       #'(lambda ()
  67                           (send *listener* :paste-string
  68                                 (format nil ":e ~s~%"
  69                                         (send text-item :text)))))
  70                 (send button-item-proto :new "Next"
  71                       :action
  72                       #'(lambda ()
  73                           (send *listener* :paste-string
  74                                 (format nil ":n~%"))))
  75                 (send button-item-proto :new "Skip"
  76                       :action
  77                       #'(lambda ()
  78                           (send *listener* :paste-string
  79                                 (format nil ":s~%")))))
  80           :type 'modeless)))