[Openmcl-cvs-notifications] r12663 - in /trunk/source: cocoa-ide/cocoa-editor.lisp cocoa-ide/cocoa-listener.lisp cocoa-ide/hemlock/src/listener.lisp level-1/l1-readloop-lds.lisp level-1/l1-streams.lisp
gz at clozure.com
gz at clozure.com
Mon Aug 24 12:21:11 EDT 2009
Author: gz
Date: Mon Aug 24 12:21:11 2009
New Revision: 12663
Log:
Make eval-selection (cmd-E, Enter) in the IDE do source location recording
Modified:
trunk/source/cocoa-ide/cocoa-editor.lisp
trunk/source/cocoa-ide/cocoa-listener.lisp
trunk/source/cocoa-ide/hemlock/src/listener.lisp
trunk/source/level-1/l1-readloop-lds.lisp
trunk/source/level-1/l1-streams.lisp
Modified: trunk/source/cocoa-ide/cocoa-editor.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/cocoa-editor.lisp (original)
+++ trunk/source/cocoa-ide/cocoa-editor.lisp Mon Aug 24 12:21:11 2009
@@ -1337,9 +1337,10 @@
(text (#/string self)))
(dotimes (i (#/count ranges))
(let* ((r (#/rangeValue (#/objectAtIndex: ranges i)))
- (s (#/substringWithRange: text r)))
+ (s (#/substringWithRange: text r))
+ (o (ns:ns-range-location r)))
(setq s (lisp-string-from-nsstring s))
- (ui-object-eval-selection *NSApp* (list package-name pathname s)))=
)))
+ (ui-object-eval-selection *NSApp* (list package-name pathname s o)=
)))))
=
(objc:defmethod (#/evalAll: :void) ((self hemlock-text-view) sender)
(declare (ignore sender))
Modified: trunk/source/cocoa-ide/cocoa-listener.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/cocoa-listener.lisp (original)
+++ trunk/source/cocoa-ide/cocoa-listener.lisp Mon Aug 24 12:21:11 2009
@@ -48,6 +48,8 @@
(cur-string-pos :initform 0)
(cur-env :initform nil)
(cur-sstream :initform nil)
+ (cur-offset :initform nil)
+ (source-map :initform nil)
(reading-line :initform nil :accessor hi:input-stream-reading-line)))
=
=
@@ -75,15 +77,21 @@
(setf cur-string s cur-string-pos 1)
(return (aref s 0))))))))))
=
-(defmethod ccl::read-toplevel-form ((stream cocoa-listener-input-stream) e=
of-value)
- (with-slots (queue queue-lock read-lock queue-semaphore text-semaphore c=
ur-string cur-string-pos cur-sstream cur-env) stream
+(defmethod ccl::read-toplevel-form ((stream cocoa-listener-input-stream) &=
key eof-value)
+ (with-slots (queue queue-lock read-lock queue-semaphore text-semaphore c=
ur-string cur-string-pos cur-sstream
+ cur-env source-map cur-offset)
+ stream
(with-lock-grabbed (read-lock)
(loop
(when cur-sstream
#+debug (log-debug "About to recursively read from sstring in en=
v: ~s" cur-env)
(let* ((env cur-env)
(form (progv (car env) (cdr env)
- (ccl::read-toplevel-form cur-sstream eof-value)))
+ (ccl::read-toplevel-form cur-sstream
+ :eof-value eof-value
+ :file-name *loading-file=
-source-file*
+ :start-offset cur-offset
+ :map source-map)))
(last-form-in-selection (not (listen cur-sstream))))
#+debug (log-debug " --> ~s" form)
(when last-form-in-selection
@@ -101,18 +109,22 @@
(assert (timed-wait-on-semaphore text-semaphore 0) () "te=
xt/queue mismatch!")
(setq cur-string val cur-string-pos 0))
(t
- (destructuring-bind (string package-name pathname) val
- (let ((env (cons '(*loading-file-source-file* *loading-=
toplevel-location*)
- (list pathname nil))))
+ (destructuring-bind (string package-name pathname offset)=
val
+ ;; This env is used both for read and eval. *nx-source=
-note-map* is for the latter.
+ (let ((env (cons '(*loading-file-source-file* *loading-=
toplevel-location* ccl::*nx-source-note-map*)
+ (list pathname nil source-map))))
(when package-name
(push '*package* (car env))
(push (ccl::pkg-arg package-name) (cdr env)))
- (setf cur-sstream (make-string-input-stream string) c=
ur-env env))))))))))
-
-(defmethod enqueue-toplevel-form ((stream cocoa-listener-input-stream) str=
ing &key package-name pathname)
+ (if source-map
+ (clrhash source-map)
+ (setf source-map (make-hash-table :test 'eq :shared=
nil)))
+ (setf cur-sstream (make-string-input-stream string) c=
ur-env env cur-offset offset))))))))))
+
+(defmethod enqueue-toplevel-form ((stream cocoa-listener-input-stream) str=
ing &key package-name pathname offset)
(with-slots (queue-lock queue queue-semaphore) stream
(with-lock-grabbed (queue-lock)
- (setq queue (nconc queue (list (list string package-name pathname))))
+ (setq queue (nconc queue (list (list string package-name pathname of=
fset))))
(signal-semaphore queue-semaphore))))
=
(defmethod enqueue-listener-input ((stream cocoa-listener-input-stream) st=
ring)
@@ -639,9 +651,9 @@
=
=
(defmethod eval-in-listener-process ((process cocoa-listener-process)
- string &key path package)
+ string &key path package offset)
(enqueue-toplevel-form (cocoa-listener-process-input-stream process) str=
ing
- :package-name package :pathname path))
+ :package-name package :pathname path :offset offs=
et))
=
;;; This is basically used to provide INPUT to the listener process, by
;;; writing to an fd which is connected to that process's standard
@@ -671,22 +683,22 @@
(let* ((target-listener (ui-object-choose-listener-for-selection
app selection)))
(when target-listener
- (destructuring-bind (package path string) selection
- (eval-in-listener-process target-listener string :package package =
:path path)))))
+ (destructuring-bind (package path string &optional offset) selection
+ (eval-in-listener-process target-listener string :package package =
:path path :offset offset)))))
=
(defmethod ui-object-load-buffer ((app ns:ns-application) selection)
(let* ((target-listener (ui-object-choose-listener-for-selection app nil=
)))
(when target-listener
(destructuring-bind (package path) selection
(let ((string (format nil "(load ~S)" path)))
- (eval-in-listener-process target-listener string :package packag=
e :path path))))))
+ (eval-in-listener-process target-listener string :package packag=
e))))))
=
(defmethod ui-object-compile-buffer ((app ns:ns-application) selection)
(let* ((target-listener (ui-object-choose-listener-for-selection app nil=
)))
(when target-listener
(destructuring-bind (package path) selection
(let ((string (format nil "(compile-file ~S)" path)))
- (eval-in-listener-process target-listener string :package packag=
e :path path))))))
+ (eval-in-listener-process target-listener string :package packag=
e))))))
=
(defmethod ui-object-compile-and-load-buffer ((app ns:ns-application) sele=
ction)
(let* ((target-listener (ui-object-choose-listener-for-selection app nil=
)))
@@ -697,7 +709,7 @@
(make-pathname :directory (pathname-director=
y path)
:name (pathname-name path)
:type (pathname-type path)))))
- (eval-in-listener-process target-listener string :package packag=
e :path path))))))
+ (eval-in-listener-process target-listener string :package packag=
e))))))
=
=
=
Modified: trunk/source/cocoa-ide/hemlock/src/listener.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/hemlock/src/listener.lisp (original)
+++ trunk/source/cocoa-ide/hemlock/src/listener.lisp Mon Aug 24 12:21:11 20=
09
@@ -584,9 +584,8 @@
(package (variable-value 'current-package :buffer (current-buffer)))
(path (buffer-pathname (current-buffer))))
(evaluate-input-selection
- (list package path (region-to-string region))))
- =
- =
+ (list package path (region-to-string region) (mark-absolute-position (r=
egion-start region)))))
+
=
(defun editor-compile-region (region &optional quiet)
(unless quiet (message "Compiling region ..."))
Modified: trunk/source/level-1/l1-readloop-lds.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-readloop-lds.lisp (original)
+++ trunk/source/level-1/l1-readloop-lds.lisp Mon Aug 24 12:21:11 2009
@@ -393,7 +393,7 @@
(eof-value *eof-value*))
(force-output output-stream)
(funcall prompt-function output-stream)
- (read-toplevel-form input-stream eof-value))
+ (read-toplevel-form input-stream :eof-value eof-value))
=
(defvar *always-eval-user-defvars* nil)
=
Modified: trunk/source/level-1/l1-streams.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/level-1/l1-streams.lisp (original)
+++ trunk/source/level-1/l1-streams.lisp Mon Aug 24 12:21:11 2009
@@ -5848,20 +5848,18 @@
;;; that contain multiple forms are handled; see *VERBOSE-EVAL-SELECTION*
;;; and the SELECTION-INPUT-STREAM method below.)
=
-(defmethod read-toplevel-form ((stream synonym-stream) eof-value)
- (read-toplevel-form (symbol-value (synonym-stream-symbol stream)) eof-va=
lue))
-
-(defmethod read-toplevel-form ((stream two-way-stream) eof-value)
+(defmethod read-toplevel-form ((stream synonym-stream) &rest keys)
+ (apply #'read-toplevel-form (symbol-value (synonym-stream-symbol stream)=
) keys))
+
+(defmethod read-toplevel-form ((stream two-way-stream) &rest keys)
(if (typep stream 'echo-stream)
(call-next-method)
- (read-toplevel-form (two-way-stream-input-stream stream) eof-value)))
-
-(defmethod read-toplevel-form :after ((stream echoing-two-way-stream) eof-=
value)
- (declare (ignore eof-value))
+ (apply #'read-toplevel-form (two-way-stream-input-stream stream) keys)=
))
+
+(defmethod read-toplevel-form :after ((stream echoing-two-way-stream) &key=
&allow-other-keys)
(stream-set-column (two-way-stream-output-stream stream) 0))
=
-(defmethod read-toplevel-form ((stream input-stream)
- eof-value)
+(defmethod read-toplevel-form ((stream input-stream) &key eof-value file-n=
ame start-offset map)
(loop
(let* ((*in-read-loop* nil)
(first-char (peek-char t stream nil eof-value))
@@ -5870,7 +5868,11 @@
(cond ((eq first-char #\:)
(read-command-or-keyword stream eof-value))
((eq first-char eof-value) eof-value)
- (t (read stream nil eof-value))))))
+ (t (read-recording-source stream :eofval eof-value
+ :file-name file-name
+ :start-offset start-offset
+ :map map
+ :save-source-text t))))))
(if (eq form eof-value)
(return (values form nil t))
(progn
@@ -5891,7 +5893,7 @@
are printed.")
=
(defmethod read-toplevel-form ((stream selection-input-stream)
- eof-value)
+ &key eof-value &allow-other-keys)
(if (eq (stream-peek-char stream) :eof)
(values eof-value nil t)
(let* ((*package* *package*)
More information about the Openmcl-cvs-notifications
mailing list