Changeset 12399


Ignore:
Timestamp:
Jul 11, 2009, 12:11:20 AM (10 years ago)
Author:
mikel
Message:

Trac #155 and #501:

Fixes most of the issues reported in these tickets. Remaining work needs to be done on handling strings that contain incomplete or otherwise "not balanced" expressions, in order to deal with the comment issue in #501 and the issue of handling prior output that isn't selected in #501.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/cocoa-ide/hemlock/src/listener.lisp

    r12321 r12399  
    187187                  (setq skip-whitespace t))))))))))
    188188               
    189            
    190  
     189#| old version
    191190(defcommand "Confirm Listener Input" (p)
    192191  "Evaluate Listener Mode input between point and last prompt."
     
    208207          (append-font-regions (current-buffer))
    209208          (hemlock-ext:send-string-to-listener (current-buffer) string))))))
     209|#
     210
     211(defun point-at-prompt-p ()
     212  (with-mark ((input-mark (value buffer-input-mark))
     213              (end-mark (value buffer-input-mark)))
     214    (buffer-end end-mark)
     215    (and (mark>= (current-point) input-mark)
     216         (mark>= end-mark (current-point)))))
     217
     218(defun send-input-region-to-lisp ()
     219  (let* ((input-region (get-interactive-input))
     220         (r (if input-region
     221                (region (copy-mark (region-start input-region))
     222                        (copy-mark (region-end input-region) :right-inserting)))))
     223
     224    (when input-region
     225      (insert-character (current-point-for-insertion) #\NewLine)
     226      (when (or (input-stream-reading-line
     227                 (top-listener-input-stream))
     228                (balanced-expressions-in-region input-region))
     229        (let* ((string (region-to-string input-region)))
     230          (push (cons r nil) (value input-regions))
     231          (move-mark (value buffer-input-mark) (current-point))
     232          (append-font-regions (current-buffer))
     233          (hemlock-ext:send-string-to-listener (current-buffer) string))))))
     234
     235
     236(defun send-region-to-lisp (region)
     237  (let* ((region-string (when region (region-to-string region))))
     238    (with-mark ((input-mark (value buffer-input-mark)))
     239      (move-mark (current-point) input-mark)
     240      (insert-string (current-point) region-string)
     241      (send-input-region-to-lisp))))
     242
     243(defun send-expression-at-point-to-lisp ()
     244  ;; if it's not a well-formed expression, try to fix it up and send it
     245  ;; if we fail, don't send it
     246  )
     247
     248(defcommand "Confirm Listener Input" (p)
     249    "Evaluate Listener Mode input between point and last prompt."
     250    "Evaluate Listener Mode input between point and last prompt."
     251  (declare (ignore p))
     252  (if (point-at-prompt-p)
     253      (send-input-region-to-lisp)
     254      (if (region-active-p)
     255          (let ((selected-region (current-region nil nil)))
     256            (send-region-to-lisp selected-region))
     257          (let ((prior-region (input-region-containing-mark (current-point) (value input-regions))))
     258            (if prior-region
     259                (send-region-to-lisp prior-region)
     260                (send-expression-at-point-to-lisp))))))
     261
    210262
    211263(defparameter *pop-string* ":POP
     
    249301   input mark, and the end is the current point moved to the end of the buffer."
    250302  (let ((point (current-point))
    251         (mark (value buffer-input-mark)))
     303        (mark (value buffer-input-mark)))
    252304    (cond
    253      ((mark>= point mark)
    254       (buffer-end point)
    255       (let* ((input-region (region mark point))
    256              (string (region-to-string input-region))
    257              (ring (value interactive-history)))
    258         (when (and (or (zerop (ring-length ring))
    259                        (string/= string (region-to-string (ring-ref ring 0))))
    260                    (> (length string) (value minimum-interactive-input-length)))
    261           (ring-push (copy-region input-region) ring))
    262         input-region))
    263      (t
    264       (let* ((region (input-region-containing-mark point (value input-regions ))))
    265         (buffer-end point)
    266         (if region
    267           (progn
    268             (delete-region (region mark point))
    269             (insert-region point region))
    270           (beep))
    271         nil)))))
     305      ((mark>= point mark)
     306       (buffer-end point)
     307       (let* ((input-region (region mark point))
     308              (string (region-to-string input-region))
     309              (ring (value interactive-history)))
     310         (when (and (or (zerop (ring-length ring))
     311                        (string/= string (region-to-string (ring-ref ring 0))))
     312                    (> (length string) (value minimum-interactive-input-length)))
     313           (ring-push (copy-region input-region) ring))
     314         input-region))
     315      (t
     316       (let* ((region (input-region-containing-mark point (value input-regions ))))
     317         (buffer-end point)
     318         (if region
     319             (progn
     320               (delete-region (region mark point))
     321               (insert-region point region))
     322             (beep))
     323         nil)))))
    272324
    273325
Note: See TracChangeset for help on using the changeset viewer.