From 957a18560bdd6fc1a94e0e4221f51c0b2e72fa65 Mon Sep 17 00:00:00 2001
From: chiles <chiles>
Date: Wed, 29 May 1991 11:40:48 +0000
Subject: [PATCH] Implemented "Debug Edit Source" and EDIT-SOURCE-LOCATION,
 which the slave calls remotely in the editor.  This is a first cut at this
 stuff for experience purposes.

---
 hemlock/debug.lisp | 160 ++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 159 insertions(+), 1 deletion(-)

diff --git a/hemlock/debug.lisp b/hemlock/debug.lisp
index 629f39038..1fef800aa 100644
--- a/hemlock/debug.lisp
+++ b/hemlock/debug.lisp
@@ -8,7 +8,7 @@
 ;;;
 #|
 (ext:file-comment
-  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/debug.lisp,v 1.1 1991/05/27 12:35:29 chiles Exp $")
+  "$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/hemlock/debug.lisp,v 1.2 1991/05/29 11:40:48 chiles Exp $")
 |#
 ;;;
 ;;; **********************************************************************
@@ -134,6 +134,164 @@
    current frame with surrounding forms for context."
   :vsource)
 
+;;; Okay, the :edit-source command in the debugger initiates a synchronous RPC
+;;; into the editor via the wire in *termina-io*, a typescript stream.  This
+;;; routine takes the necessary values, a file and source-path, and changes
+;;; the editor's state to edit that.
+;;;
+;;; This command has to wait on SERVE-EVENT until some special is set by the
+;;; RPC routine saying it is okay to return to the editor's top level.
+;;;
+(defcommand "Debug Edit Source" (p)
+  "Give the \"Current Eval Server\"'s current debugger frame, place the user
+   at the location's source in the editor."
+  "Give the \"Current Eval Server\"'s current debugger frame, place the user
+   at the location's source in the editor."
+  (declare (ignore p))
+  (let* ((server-info (get-current-eval-server t))
+	 (wire (server-info-wire server-info)))
+    (wire:remote wire
+      (ts-stream-accept-input
+       (ts-data-stream (server-info-slave-info server-info))
+       :edit-source))
+    (wire:wire-force-output wire))))
+
+
+;;; Okay, the :edit-source command in the slave debugger initiates a
+;;; synchronous RPC into the editor via the wire in *termina-io*, a typescript
+;;; stream.  This routine takes the necessary values, a file and source-path,
+;;; and changes the editor's state to edit that.
+;;;
+;;; This command has to wait on SERVE-EVENT until some special is set by the
+;;; RPC routine saying it is okay to return to the editor's top level.
+;;;
+(defvar *debug-editor-source-data* nil)
+
+(defcommand "Debug Edit Source" (p)
+  "Give the \"Current Eval Server\"'s current debugger frame, place the user
+   at the location's source in the editor."
+  "Give the \"Current Eval Server\"'s current debugger frame, place the user
+   at the location's source in the editor."
+  (declare (ignore p))
+  (let* ((server-info (get-current-eval-server t))
+	 (wire (server-info-wire server-info)))
+    ;;
+    ;; Tell the slave to tell the editor some source info.
+    (wire:remote wire
+      (ts-stream-accept-input
+       (ts-data-stream (server-info-slave-info server-info))
+       :edit-source))
+    (wire:wire-force-output wire)
+    ;;
+    ;; Wait for the source info.
+    (let ((*debug-editor-source-data* nil))
+      (loop
+	(system:serve-event)
+	(when *debug-editor-source-data* (return))))))
+
+;;; EDIT-SOURCE-LOCATION -- Internal Interface.
+;;;
+;;; The slave calls this in the editor when the debugger gets an :edit-source
+;;; command.  This receives the information necessary to take the user in
+;;; Hemlock to the source location, and does it.
+;;;
+(defun edit-source-location (name source-created-date tlf-offset
+			     local-tlf-offset char-offset form-number)
+  (let ((pn (pathname name)))
+    (unless (probe-file pn)
+      (editor-error "Source file no longer exists: ~A." name))
+    (multiple-value-bind (buffer newp) (find-file-buffer pn)
+      (let ((date (buffer-write-date buffer))
+	    (point (buffer-point buffer)))
+	(when newp (push-buffer-mark (copy-mark point) nil))
+	(buffer-start point)
+	;;
+	;; Get to the top-level form in the buffer.
+	(cond ((buffer-modified buffer)
+	       (loud-message "Buffer has been modified.  Using form offset ~
+			      instead of character position.")
+	       (dotimes (i local-tlf-offset) 
+		 (pre-command-parse-check point)
+		 (form-offset point 1)))
+	      ((not date)
+	       (loud-message "Cannot compare write dates.  Assuming source ~
+			      has not been modified -- ~A."
+			     name)
+	       (character-offset point char-offset))
+	      ((= source-created-date date)
+	       (character-offset point char-offset))
+	      (t
+	       (loud-message "File has been modified since reading the source.  ~
+			      Using form offset instead of character position.")
+	       (dotimes (i local-tlf-offset) 
+		 (pre-command-parse-check point)
+		 (form-offset point 1))))
+	;;
+	;; Read our form, get form-number translations, get the source-path,
+	;; and make it usable.
+	(let ((path (nreverse
+		     (butlast
+		      (cdr
+		       (svref (di:form-number-translations
+			       (with-input-from-region
+				   (s (region point (buffer-end-mark buffer)))
+				 (read s))
+			       tlf-offset)
+			      form-number)))))
+	      (quote-or-function nil))
+	  ;;
+	  ;; Walk down to the form.
+	  (change-to-buffer buffer)
+	  (pre-command-parse-check point)
+	  (dolist (n path)
+	    (when quote-or-function
+	      (editor-error
+	       "Apparently settled on the symbol QUOTE or FUNCTION via their ~
+		read macros, which is odd, but furthermore there seems to be ~
+		more source-path left."))
+	    (unless (form-offset point 1)
+	      ;; Want to use the following and delete the next FORM-OFFSET -1.
+	      ;; (scan-direction-valid point t (or :open-paren :prefix))
+	      (editor-error
+	       "Ran out of text in buffer with more source-path remaining."))
+	    (form-offset point -1)
+	    (ecase (next-character point)
+	      (#\(
+	       (mark-after point)
+	       (form-offset point n))
+	      (#\'
+	       (case n
+		 (0 (setf quote-or-function t))
+		 (1 (mark-after point))
+		 (t (editor-error "Next form is QUOTE, but source-path index ~
+				   is other than zero or one."))))
+	      (#\#
+	       (case (next-character (mark-after point))
+		 (#\'
+		  (case n
+		    (0 (setf quote-or-function t))
+		    (1 (mark-after point))
+		    (t (editor-error "Next form is FUNCTION, but source-path ~
+				      index is other than zero or one."))))
+		 (t (editor-error
+		     "Can only parse ' and #' read macros."))))))
+	  ;; Get to the beginning of the form.
+	  (form-offset point 1)
+	  (form-offset point -1)))))
+  (setf *debug-editor-source-data* t)
+  ;;
+  ;; While Hemlock was setting up the source edit, the user could have typed
+  ;; while looking at a buffer no longer current when the commands execute.
+  (clear-editor-input *editor-input*))
+
+;;; CANNOT-EDIT-SOURCE-LOCATION -- Interface.
+;;;
+;;; The slave calls this when the debugger command "EDIT-SOURCE" runs, and the
+;;; slave cannot give the editor source information.
+;;;
+(defun cannot-edit-source-location ()
+  (throw 'editor-top-level nil))
+
 ;;;
 ;;; Miscellaneous commands.
 ;;;
-- 
GitLab