Changeset 12663


Ignore:
Timestamp:
Aug 24, 2009, 4:21:11 PM (10 years ago)
Author:
gz
Message:

Make eval-selection (cmd-E, Enter) in the IDE do source location recording

Location:
trunk/source
Files:
5 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/cocoa-editor.lisp

    r12636 r12663  
    13431343    (dotimes (i (#/count ranges))
    13441344      (let* ((r (#/rangeValue (#/objectAtIndex: ranges i)))
    1345              (s (#/substringWithRange: text r)))
     1345             (s (#/substringWithRange: text r))
     1346             (o (ns:ns-range-location r)))
    13461347        (setq s (lisp-string-from-nsstring s))
    1347         (ui-object-eval-selection *NSApp* (list package-name pathname s))))))
     1348        (ui-object-eval-selection *NSApp* (list package-name pathname s o))))))
    13481349
    13491350(objc:defmethod (#/evalAll: :void) ((self hemlock-text-view) sender)
  • trunk/source/cocoa-ide/cocoa-listener.lisp

    r12652 r12663  
    4949   (cur-env :initform nil)
    5050   (cur-sstream :initform nil)
     51   (cur-offset :initform nil)
     52   (source-map :initform nil)
    5153   (reading-line :initform nil :accessor hi:input-stream-reading-line)))
    5254
     
    7678                  (return (aref s 0))))))))))
    7779
    78 (defmethod ccl::read-toplevel-form ((stream cocoa-listener-input-stream) eof-value)
    79   (with-slots (queue queue-lock read-lock queue-semaphore text-semaphore cur-string cur-string-pos cur-sstream cur-env) stream
     80(defmethod ccl::read-toplevel-form ((stream cocoa-listener-input-stream) &key eof-value)
     81  (with-slots (queue queue-lock read-lock queue-semaphore text-semaphore cur-string cur-string-pos cur-sstream
     82               cur-env source-map cur-offset)
     83    stream
    8084    (with-lock-grabbed (read-lock)
    8185      (loop
     
    8488          (let* ((env cur-env)
    8589                 (form (progv (car env) (cdr env)
    86                          (ccl::read-toplevel-form cur-sstream eof-value)))
     90                         (ccl::read-toplevel-form cur-sstream
     91                                                  :eof-value eof-value
     92                                                  :file-name *loading-file-source-file*
     93                                                  :start-offset cur-offset
     94                                                  :map source-map)))
    8795                 (last-form-in-selection (not (listen cur-sstream))))
    8896            #+debug (log-debug " --> ~s" form)
     
    102110                 (setq cur-string val cur-string-pos 0))
    103111                (t
    104                  (destructuring-bind (string package-name pathname) val
    105                    (let ((env (cons '(*loading-file-source-file* *loading-toplevel-location*)
    106                                     (list pathname nil))))
     112                 (destructuring-bind (string package-name pathname offset) val
     113                   ;; This env is used both for read and eval.  *nx-source-note-map* is for the latter.
     114                   (let ((env (cons '(*loading-file-source-file* *loading-toplevel-location* ccl::*nx-source-note-map*)
     115                                    (list pathname nil source-map))))
    107116                     (when package-name
    108117                       (push '*package* (car env))
    109118                       (push (ccl::pkg-arg package-name) (cdr env)))
    110                      (setf cur-sstream (make-string-input-stream string) cur-env env))))))))))
    111 
    112 (defmethod enqueue-toplevel-form ((stream cocoa-listener-input-stream) string &key package-name pathname)
     119                     (if source-map
     120                       (clrhash source-map)
     121                       (setf source-map (make-hash-table :test 'eq :shared nil)))
     122                     (setf cur-sstream (make-string-input-stream string) cur-env env cur-offset offset))))))))))
     123
     124(defmethod enqueue-toplevel-form ((stream cocoa-listener-input-stream) string &key package-name pathname offset)
    113125  (with-slots (queue-lock queue queue-semaphore) stream
    114126    (with-lock-grabbed (queue-lock)
    115       (setq queue (nconc queue (list (list string package-name pathname))))
     127      (setq queue (nconc queue (list (list string package-name pathname offset))))
    116128      (signal-semaphore queue-semaphore))))
    117129
     
    640652
    641653(defmethod eval-in-listener-process ((process cocoa-listener-process)
    642                                      string &key path package)
     654                                     string &key path package offset)
    643655  (enqueue-toplevel-form (cocoa-listener-process-input-stream process) string
    644                          :package-name package :pathname path))
     656                         :package-name package :pathname path :offset offset))
    645657
    646658;;; This is basically used to provide INPUT to the listener process, by
     
    672684                           app selection)))
    673685    (when target-listener
    674       (destructuring-bind (package path string) selection
    675         (eval-in-listener-process target-listener string :package package :path path)))))
     686      (destructuring-bind (package path string &optional offset) selection
     687        (eval-in-listener-process target-listener string :package package :path path :offset offset)))))
    676688
    677689(defmethod ui-object-load-buffer ((app ns:ns-application) selection)
     
    680692      (destructuring-bind (package path) selection
    681693        (let ((string (format nil "(load ~S)" path)))
    682           (eval-in-listener-process target-listener string :package package :path path))))))
     694          (eval-in-listener-process target-listener string :package package))))))
    683695
    684696(defmethod ui-object-compile-buffer ((app ns:ns-application) selection)
     
    687699      (destructuring-bind (package path) selection
    688700        (let ((string (format nil "(compile-file ~S)" path)))
    689           (eval-in-listener-process target-listener string :package package :path path))))))
     701          (eval-in-listener-process target-listener string :package package))))))
    690702
    691703(defmethod ui-object-compile-and-load-buffer ((app ns:ns-application) selection)
     
    698710                                             :name (pathname-name path)
    699711                                             :type (pathname-type path)))))
    700           (eval-in-listener-process target-listener string :package package :path path))))))
     712          (eval-in-listener-process target-listener string :package package))))))
    701713
    702714       
  • trunk/source/cocoa-ide/hemlock/src/listener.lisp

    r12599 r12663  
    588588                    (path (buffer-pathname (current-buffer))))
    589589  (evaluate-input-selection
    590    (list package path (region-to-string region))))
    591        
    592                                        
     590   (list package path (region-to-string region) (mark-absolute-position (region-start region)))))
     591
    593592
    594593(defun editor-compile-region (region &optional quiet)
  • trunk/source/level-1/l1-readloop-lds.lisp

    r12463 r12663  
    394394  (force-output output-stream)
    395395  (funcall prompt-function output-stream)
    396   (read-toplevel-form input-stream eof-value))
     396  (read-toplevel-form input-stream :eof-value eof-value))
    397397
    398398(defvar *always-eval-user-defvars* nil)
  • trunk/source/level-1/l1-streams.lisp

    r12530 r12663  
    58585858;;; and the SELECTION-INPUT-STREAM method below.)
    58595859
    5860 (defmethod read-toplevel-form ((stream synonym-stream) eof-value)
    5861   (read-toplevel-form (symbol-value (synonym-stream-symbol stream)) eof-value))
    5862 
    5863 (defmethod read-toplevel-form ((stream two-way-stream) eof-value)
     5860(defmethod read-toplevel-form ((stream synonym-stream) &rest keys)
     5861  (apply #'read-toplevel-form (symbol-value (synonym-stream-symbol stream)) keys))
     5862
     5863(defmethod read-toplevel-form ((stream two-way-stream) &rest keys)
    58645864  (if (typep stream 'echo-stream)
    58655865    (call-next-method)
    5866     (read-toplevel-form (two-way-stream-input-stream stream) eof-value)))
    5867 
    5868 (defmethod read-toplevel-form :after ((stream echoing-two-way-stream) eof-value)
    5869   (declare (ignore eof-value))
     5866    (apply #'read-toplevel-form (two-way-stream-input-stream stream) keys)))
     5867
     5868(defmethod read-toplevel-form :after ((stream echoing-two-way-stream) &key &allow-other-keys)
    58705869  (stream-set-column (two-way-stream-output-stream stream) 0))
    58715870
    5872 (defmethod read-toplevel-form ((stream input-stream)
    5873                                eof-value)
     5871(defmethod read-toplevel-form ((stream input-stream) &key eof-value file-name start-offset map)
    58745872  (loop
    58755873    (let* ((*in-read-loop* nil)
     
    58805878                     (read-command-or-keyword stream eof-value))
    58815879                    ((eq first-char eof-value) eof-value)
    5882                     (t (read stream nil eof-value))))))
     5880                    (t (read-recording-source stream :eofval eof-value
     5881                                              :file-name file-name
     5882                                              :start-offset start-offset
     5883                                              :map map
     5884                                              :save-source-text t))))))
    58835885      (if (eq form eof-value)
    58845886        (return (values form nil t))
     
    59015903
    59025904(defmethod read-toplevel-form ((stream selection-input-stream)
    5903                                eof-value)
     5905                               &key eof-value &allow-other-keys)
    59045906  (if (eq (stream-peek-char stream) :eof)
    59055907    (values eof-value nil t)
Note: See TracChangeset for help on using the changeset viewer.