Changeset 771
- Timestamp:
- Apr 13, 2004, 12:16:13 PM (21 years ago)
- File:
-
- 1 edited
-
trunk/ccl/examples/cocoa-editor.lisp (modified) (9 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/ccl/examples/cocoa-editor.lisp
r764 r771 223 223 ;;; number of preceding lines. 224 224 (defun mark-absolute-position (mark) 225 (let* ((pos (hi::mark-charpos mark))) 225 (let* ((pos (hi::mark-charpos mark)) 226 (hi::*buffer-gap-context* (hi::buffer-gap-context (hi::line-%buffer 227 (hi::mark-line mark))))) 226 228 (do* ((line (hi::line-previous (hi::mark-line mark)) 227 229 (hi::line-previous line))) … … 320 322 (not (eql (slot-value self 'edit-count) 0))) 321 323 324 325 (define-objc-method (((:struct :<NSR>ange r) :double-click-at-index (:unsigned index)) 326 hemlock-text-storage) 327 (block HANDLED 328 (let* ((cache (hemlock-buffer-string-cache (send self 'string))) 329 (buffer (if cache (buffer-cache-buffer cache)))) 330 (when (and buffer (string= (hi::buffer-major-mode buffer) "Lisp")) 331 (let* ((hi::*buffer-gap-context* (hi::buffer-gap-context buffer))) 332 (hi::with-mark ((m1 (hi::buffer-point buffer))) 333 (move-hemlock-mark-to-absolute-position m1 cache index) 334 (hemlock::pre-command-parse-check m1) 335 (when (hemlock::valid-spot m1 nil) 336 (cond ((eql (hi::next-character m1) #\() 337 (hi::with-mark ((m2 m1)) 338 (when (hemlock::list-offset m2 1) 339 (setf (pref r :<NSR>ange.location) index 340 (pref r :<NSR>ange.length) 341 (- (mark-absolute-position m2) index)) 342 (return-from HANDLED nil)))) 343 ((eql (hi::previous-character m1) #\)) 344 (hi::with-mark ((m2 m1)) 345 (when (hemlock::list-offset m2 -1) 346 (#_NSLog #@"Length = %d" 347 :unsigned 348 (- (1- index) (mark-absolute-position m2))) 349 (setf (pref r :<NSR>ange.location) 350 (mark-absolute-position m2) 351 (pref r :<NSR>ange.length) 352 (- (1- index) (mark-absolute-position m2))) 353 (return-from HANDLED nil))))))))) 354 ;; No early exit, so call next-method 355 (objc-message-send-super-stret r (super) "doubleClickAtIndex:" 356 :unsigned index 357 :void)))) 358 359 360 361 362 363 364 365 322 366 (defun textstorage-note-insertion-at-position (self pos n) 323 367 (send self … … 343 387 :change-in-length (- n)) 344 388 (let* ((display (hemlock-buffer-string-cache (send self 'string)))) 345 346 389 (reset-buffer-cache display) 390 (update-line-cache-for-index display pos)))) 347 391 348 392 (define-objc-method ((:void :note-modification params) hemlock-text-storage) … … 411 455 (svref *styles* 0))) 412 456 413 ;;; The range's origin should probably be the buffer's point; if414 ;;; the range has non-zero length, we probably need to think about415 ;;; things harder.416 457 (define-objc-method ((:void :replace-characters-in-range (:<NSR>ange r) 417 458 :with-string string) 418 459 hemlock-text-storage) 419 (declare (ignorable r string)) 420 #+debug 421 (#_NSLog #@"replace-characters-in-range (%d %d) with-string %@" 422 :unsigned (pref r :<NSR>ange.location) 423 :unsigned (pref r :<NSR>ange.length) 424 :id string)) 460 (let* ((cache (hemlock-buffer-string-cache (send self 'string))) 461 (buffer (if cache (buffer-cache-buffer cache))) 462 (hi::*buffer-gap-context* (hi::buffer-gap-context buffer)) 463 (location (pref r :<NSR>ange.location)) 464 (length (pref r :<NSR>ange.length)) 465 (mark (hi::buffer-%mark buffer)) 466 (point (hi::buffer-point buffer))) 467 (cond ((> length 0) 468 (move-hemlock-mark-to-absolute-position mark cache location) 469 (move-hemlock-mark-to-absolute-position point cache (+ location length)) 470 (hemlock::%buffer-activate-region buffer)) 471 (t 472 (move-hemlock-mark-to-absolute-position point cache location))) 473 (hi::insert-string point (lisp-string-from-nsstring string)))) 474 425 475 426 476 ;;; I'm not sure if we want the text system to be able to change … … 545 595 (when buffer 546 596 (let* ((q (hemlock-frame-event-queue (send self 'window)))) 547 (hi::enqueue-key-event q (nsevent-to-key-event event))))) 548 ;; Probably not the right place for this, but needs to happen 549 ;; -somewhere-, and needs to happen in the event thread. 550 551 ) 597 (hi::enqueue-key-event q (nsevent-to-key-event event)))))) 552 598 553 599 (defun enqueue-buffer-operation (buffer thunk) … … 555 601 (let* ((q (hemlock-frame-event-queue (send w 'window))) 556 602 (op (hi::make-buffer-operation :thunk thunk))) 557 (hi::e nqueue-key-event q op))))603 (hi::event-queue-insert q op)))) 558 604 559 605 560 606 ;;; Process a key-down NSEvent in a Hemlock text view by translating it 561 607 ;;; into a Hemlock key event and passing it into the Hemlock command 562 ;;; interpreter. The underlying buffer becomes Hemlock's current buffer 563 ;;; and the containing pane becomes Hemlock's current window when the 564 ;;; command is processed. Use the frame's command state object. 608 ;;; interpreter. 565 609 566 610 (define-objc-method ((:void :key-down event) … … 574 618 :still-selecting (:<BOOL> still-selecting)) 575 619 hemlock-text-view) 620 #+debug 621 (#_NSLog #@"Set selected range called: location = %d, length = %d, affinity = %d, still-selecting = %d" 622 :int (pref r :<NSR>ange.location) 623 :int (pref r :<NSR>ange.length) 624 :<NSS>election<A>ffinity affinity 625 :<BOOL> (if still-selecting #$YES #$NO)) 576 626 (unless (send (send self 'text-storage) 'editing-in-progress) 577 627 (let* ((d (hemlock-buffer-string-cache (send self 'string))) 578 (point (hemlock::buffer-point (buffer-cache-buffer d))) 579 (location (pref r :<NSR>ange.location)) 580 (len (pref r :<NSR>ange.length))) 581 (when (eql len 0) 582 #+debug 583 (#_NSLog #@"Moving point to absolute position %d" :int location) 584 (move-hemlock-mark-to-absolute-position point d location)))) 628 (buffer (buffer-cache-buffer d)) 629 (hi::*buffer-gap-context* (hi::buffer-gap-context buffer)) 630 (point (hi::buffer-point buffer)) 631 (location (pref r :<NSR>ange.location)) 632 (len (pref r :<NSR>ange.length))) 633 (cond ((eql len 0) 634 #+debug 635 (#_NSLog #@"Moving point to absolute position %d" :int location) 636 (setf (hi::buffer-region-active buffer) nil) 637 (move-hemlock-mark-to-absolute-position point d location)) 638 (t 639 ;; We don't get much information about which end of the 640 ;; selection the mark's at and which end point is at, so 641 ;; we have to sort of guess. In every case I've ever seen, 642 ;; selection via the mouse generates a sequence of calls to 643 ;; this method whose parameters look like: 644 ;; a: range: {n0,0} still-selecting: false [ rarely repeats ] 645 ;; b: range: {n0,0) still-selecting: true [ rarely repeats ] 646 ;; c: range: {n1,m} still-selecting: true [ often repeats ] 647 ;; d: range: {n1,m} still-selecting: false [ rarely repeats ] 648 ;; 649 ;; (Sadly, "affinity" doesn't tell us anything interesting. 650 ;; We've handled a and b in the clause above; after handling 651 ;; b, point references buffer position n0 and the 652 ;; region is inactive. 653 ;; Let's ignore c, and wait until the selection's stabilized. 654 ;; Make a new mark, a copy of point (position n0). 655 ;; At step d (here), we should have either 656 ;; d1) n1=n0. Mark stays at n0, point moves to n0+m. 657 ;; d2) n1+m=n0. Mark stays at n0, point moves to n0-m. 658 ;; If neither d1 nor d2 apply, arbitrarily assume forward 659 ;; selection: mark at n1, point at n1+m. 660 ;; In all cases, activate Hemlock selection. 661 (unless still-selecting 662 (let* ((pointpos (mark-absolute-position point)) 663 (selection-end (+ location len)) 664 (mark (hi::copy-mark point :right-inserting))) 665 (cond ((eql pointpos location) 666 (move-hemlock-mark-to-absolute-position point 667 d 668 selection-end)) 669 ((eql pointpos selection-end) 670 (move-hemlock-mark-to-absolute-position point 671 d 672 location)) 673 (t 674 (move-hemlock-mark-to-absolute-position mark 675 d 676 location) 677 (move-hemlock-mark-to-absolute-position point 678 d 679 selection-end))) 680 (hemlock::%buffer-push-buffer-mark buffer mark t))))))) 585 681 (send-super :set-selected-range r 586 682 :affinity affinity … … 1509 1605 (hi::*buffer-gap-context* (hi::buffer-gap-context buffer)) 1510 1606 (point (hi::buffer-point buffer)) 1511 (pos (mark-absolute-position point)) 1607 (pointpos (mark-absolute-position point)) 1608 (location pointpos) 1512 1609 (len 0)) 1610 (when (hemlock::%buffer-region-active-p buffer) 1611 (let* ((mark (hi::buffer-%mark buffer))) 1612 (when mark 1613 (let* ((markpos (mark-absolute-position mark))) 1614 (if (< markpos pointpos) 1615 (setq location markpos len (- pointpos markpos)) 1616 (if (< pointpos markpos) 1617 (setq location pointpos len (- markpos pointpos)))))))) 1513 1618 #+debug 1514 1619 (#_NSLog #@"update Hemlock selection: charpos = %d, abspos = %d" … … 1518 1623 #'(lambda (tv) 1519 1624 (send tv 1520 :update-selection pos1625 :update-selection location 1521 1626 :length len 1522 1627 :affinity #$NSSelectionAffinityUpstream)))))
Note:
See TracChangeset
for help on using the changeset viewer.
