Changeset 7995


Ignore:
Timestamp:
Jan 4, 2008, 5:43:11 AM (12 years ago)
Author:
gz
Message:

More forceful stream-clear-input for listener input.

Do page/line scrolling using #/scrollToPoint.

Restore code to move point to be visible after scrolling commands.

Make modeline functions no longer take a "window" arg.

Location:
branches/event-ide/ccl/cocoa-ide
Files:
4 edited

Legend:

Unmodified
Added
Removed
  • branches/event-ide/ccl/cocoa-ide/cocoa-editor.lisp

    r7993 r7995  
    555555         (buffer (buffer-cache-buffer display))
    556556         (hi::*current-buffer* buffer)
    557          (font (buffer-active-font buffer))
     557         (attributes (buffer-active-font-attributes buffer))
    558558         (document (#/document self))
    559559         (undo-mgr (and document (#/undoManager document))))
     
    572572         (#/prepareWithInvocationTarget: undo-mgr self)
    573573         pos n #@"")))
    574     (#/setAttributes:range: mirror font (ns:make-ns-range pos n))   
     574    (#/setAttributes:range: mirror attributes (ns:make-ns-range pos n))
    575575    (textstorage-note-insertion-at-position self pos n)))
    576576
     
    11181118    ((pane :foreign-type :id :accessor text-view-pane)
    11191119     (char-width :foreign-type :<CGF>loat :accessor text-view-char-width)
    1120      (char-height :foreign-type :<CGF>loat :accessor text-view-char-height))
     1120     (line-height :foreign-type :<CGF>loat :accessor text-view-line-height))
    11211121  (:metaclass ns:+ns-object))
    11221122(declaim (special hemlock-text-view))
     
    14541454;;; used in the event dispatch mechanism,
    14551455(defun draw-modeline-string (the-modeline-view)
    1456   (with-slots (pane text-attributes) the-modeline-view
     1456  (with-slots (text-attributes) the-modeline-view
    14571457    (let* ((buffer (buffer-for-modeline-view the-modeline-view)))
    14581458      (when buffer
     
    14611461                       (mapcar
    14621462                        #'(lambda (field)
    1463                             #+GZ (or (ignore-errors (funcall (hi::modeline-field-function field)
    1464                                                              buffer pane))
    1465                                      (format nil "#<~s ~s>" (hi::modeline-field-name field)
    1466                                              (and (eq (hi::modeline-field-name field) :package)
    1467                                                   (hi::variable-value 'hemlock::current-package
    1468                                                                       :buffer buffer))))
    1469 
    1470                             #-GZ
    1471                             (funcall (hi::modeline-field-function field)
    1472                                      buffer pane))
     1463                            (funcall (hi::modeline-field-function field) buffer))
    14731464                        (hi::buffer-modeline-fields buffer)))))
    14741465          (#/drawAtPoint:withAttributes: (%make-nsstring string)
     
    20612052                                        font))))
    20622053
    2063 (defun buffer-active-font (buffer)
     2054(defun buffer-active-font-attributes (buffer)
    20642055  (let* ((style 0)
    20652056         (region (hi::buffer-active-font-region buffer))
     
    21372128
    21382129
    2139 (defun size-text-pane (pane char-height char-width nrows ncols)
     2130(defun size-text-pane (pane line-height char-width nrows ncols)
    21402131  (let* ((tv (text-pane-text-view pane))
    2141          (height (fceiling (* nrows char-height)))
     2132         (height (fceiling (* nrows line-height)))
    21422133         (width (fceiling (* ncols char-width)))
    21432134         (scrollview (text-pane-scroll-view pane))
     
    21492140                      height)
    21502141      (when has-vertical-scroller
    2151         (#/setVerticalLineScroll: scrollview char-height)
    2152         (#/setVerticalPageScroll: scrollview (cgfloat 0.0) #|char-height|#))
     2142        (#/setVerticalLineScroll: scrollview line-height)
     2143        (#/setVerticalPageScroll: scrollview (cgfloat 0.0) #|line-height|#))
    21532144      (when has-horizontal-scroller
    21542145        (#/setHorizontalLineScroll: scrollview char-width)
     
    21642155        (#/setContentSize: window sv-size)
    21652156        (setf (slot-value tv 'char-width) char-width
    2166               (slot-value tv 'char-height) char-height)
     2157              (slot-value tv 'line-height) line-height)
    21672158        (#/setResizeIncrements: window
    2168                                 (ns:make-ns-size char-width char-height))))))
     2159                                (ns:make-ns-size char-width line-height))))))
    21692160                                   
    21702161 
     
    26122603    (let* ((pane (hi::hemlock-view-pane view)))
    26132604      (floor (ns:ns-size-height (#/contentSize (text-pane-scroll-view pane)))
    2614              (text-view-char-height (text-pane-text-view pane)))))
     2605             (text-view-line-height (text-pane-text-view pane)))))
    26152606
    26162607;; Beware this doesn't seem to take horizontal scrolling into account.
     
    26432634            (+ (pref rect :<NSR>ect.origin.y) (pref container-origin :<NSP>oint.y)))))
    26442635
     2636;;(nth-value 1 (charpos-xy tv (visible-charpos-range tv))) - this is smaller as it
     2637;; only includes lines fully scrolled off...
    26452638(defun text-view-vscroll (tv)
    2646   ;; Return the number of pixels scrolled off the top of the view.  I'm sure somewhere
    2647   ;; there is a cocoa functions that tells you just that, but I couldn't find it in
    2648   ;; the maze of twisty little views all alike and yet subtly different.
    2649   (nth-value 1 (charpos-xy tv (visible-charpos-range tv))))
     2639  ;; Return the number of pixels scrolled off the top of the view.
     2640  (let* ((scroll-view (text-pane-scroll-view (text-view-pane tv)))
     2641         (clip-view (#/contentView scroll-view))
     2642         (bounds (#/bounds clip-view)))
     2643    (ns:ns-rect-y bounds)))
     2644
     2645(defun set-text-view-vscroll (tv vscroll)
     2646  (let* ((scroll-view (text-pane-scroll-view (text-view-pane tv)))
     2647         (clip-view (#/contentView scroll-view))
     2648         (bounds (#/bounds clip-view)))
     2649    (decf vscroll (mod vscroll (text-view-line-height tv))) ;; show whole line
     2650    (ns:with-ns-point (new-origin (ns:ns-rect-x bounds) vscroll)
     2651      (#/scrollToPoint: clip-view (#/constrainScrollPoint: clip-view new-origin))
     2652      (#/reflectScrolledClipView: scroll-view clip-view))))
     2653
     2654(defun scroll-by-lines (tv nlines)
     2655  "Change the vertical origin of the containing scrollview's clipview"
     2656  (set-text-view-vscroll tv (+ (text-view-vscroll tv)
     2657                               (* nlines (text-view-line-height tv)))))
     2658
     2659;; TODO: should be a hemlock variable..
     2660(defvar *next-screen-context-lines* 2)
    26502661
    26512662(defmethod hemlock-ext:scroll-view ((view hi:hemlock-view) how &optional where)
    26522663  (assume-cocoa-thread)
    26532664  (let* ((tv (text-pane-text-view (hi::hemlock-view-pane view))))
     2665    (when (eq how :line)
     2666      (setq where (require-type where '(integer 0)))
     2667      (let* ((line-y (nth-value 1 (charpos-xy tv where)))
     2668             (top-y (text-view-vscroll tv))
     2669             (nlines (floor (- line-y top-y) (text-view-line-height tv))))
     2670        (setq how :lines-down where nlines)))
    26542671    (ecase how
     2672      (:center-selection
     2673       (#/centerSelectionInVisibleArea: tv +null-ptr+))
    26552674      (:page-up
    26562675       (require-type where 'null)
    2657        (#/scrollPageUp: tv +null-ptr+))
     2676       ;; TODO: next-screen-context-lines
     2677       (scroll-by-lines tv (- *next-screen-context-lines* (view-screen-lines view))))
    26582678      (:page-down
    26592679       (require-type where 'null)
    2660        (#/scrollPageDown: tv +null-ptr+))
    2661       (:center-selection
    2662        (#/centerSelectionInVisibleArea: tv +null-ptr+))
    2663       ((:lines-up :lines-down)
    2664        (setq where (require-type where 'integer))
    2665        (when (< where 0)
    2666          (setq how (if (eq how :lines-up) :lines-down :lines-up)
    2667                where (- where)))
    2668        (multiple-value-bind (npages nlines) (floor where (view-screen-lines view))
    2669          (dotimes (i npages)
    2670            (if (eq how :lines-up)
    2671              (#/scrollPageUp: tv +null-ptr+)
    2672              (#/scrollPageDown: tv +null-ptr+)))
    2673          (dotimes (i nlines)
    2674            (if (eq how :lines-up)
    2675              (#/scrollLineUp: tv +null-ptr+)
    2676              (#/scrollLineDown: tv +null-ptr+)))))
    2677       (:line
    2678        (setq where (require-type where '(integer 0)))
    2679        (let* ((line-y (nth-value 1 (charpos-xy tv where)))
    2680               (top-y (text-view-vscroll tv))
    2681               (nlines (floor (- line-y top-y) (text-view-char-height tv))))
    2682          (hemlock-ext:scroll-view view :lines-down nlines))))))
     2680       (scroll-by-lines tv (- (view-screen-lines view) *next-screen-context-lines*)))
     2681      (:lines-up
     2682       (scroll-by-lines tv (- (require-type where 'integer))))
     2683      (:lines-down
     2684       (scroll-by-lines tv (require-type where 'integer))))
     2685    ;; If point is not on screen, move it.
     2686    (let* ((point (hi::current-point))
     2687           (point-pos (hi::mark-absolute-position point)))
     2688      (multiple-value-bind (win-pos win-len) (visible-charpos-range tv)
     2689        (unless (and (<= win-pos point-pos) (< point-pos (+ win-pos win-len)))
     2690          (let* ((point (hi::current-point-collapsing-selection))
     2691                 (cache (hemlock-buffer-string-cache (#/hemlockString (#/textStorage tv)))))
     2692            (move-hemlock-mark-to-absolute-position point cache win-pos)
     2693            (update-hemlock-selection (#/textStorage tv))))))))
    26832694
    26842695(defun iana-charset-name-of-nsstringencoding (ns)
  • branches/event-ide/ccl/cocoa-ide/cocoa-listener.lisp

    r7993 r7995  
    6767      (loop
    6868        (when cur-sstream
     69          #+gz (log-debug "About to recursively read from sstring in env: ~s" cur-env)
    6970          (let* ((env cur-env)
    7071                 (form (progv (car env) (cdr env)
    7172                         (ccl::read-toplevel-form cur-sstream eof-value)))
    7273                 (last-form-in-selection (not (listen cur-sstream))))
     74            #+gz (log-debug " --> ~s" form)
    7375            (when last-form-in-selection
    7476              (setf cur-sstream nil cur-env nil))
     
    130132
    131133(defmethod stream-clear-input ((stream cocoa-listener-input-stream))
    132   (with-slots (queue-lock cur-string cur-string-pos) stream
     134  (with-slots (queue-lock cur-string cur-string-pos cur-sstream cur-env) stream
    133135    (with-lock-grabbed (queue-lock)
    134       (setf cur-string nil cur-string-pos 0))))
    135 
     136      (setf cur-string nil cur-string-pos 0 cur-sstream nil cur-env nil))))
    136137
    137138(defparameter $listener-flush-limit 100)
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/main.lisp

    r7993 r7995  
    9090(make-modeline-field
    9191 :name :edit-level :width 15
    92  :function #'(lambda (buffer window)
    93                (declare (ignore buffer window))
     92 :function #'(lambda (buffer)
     93               (declare (ignore buffer))
    9494               (if (zerop hemlock::*recursive-edit-count*)
    9595                   ""
     
    107107(make-modeline-field
    108108 :name :completion :width 40
    109  :function #'(lambda (buffer window)
    110                (declare (ignore buffer window))
     109 :function #'(lambda (buffer)
     110               (declare (ignore buffer))
    111111               hemlock::*completion-mode-possibility*))
    112112
     
    198198    :value (list (make-modeline-field
    199199                  :name :hemlock-banner :width 27
    200                   :function #'(lambda (buffer window)
    201                                 (declare (ignore buffer window))
     200                  :function #'(lambda (buffer)
     201                                (declare (ignore buffer))
    202202                                (format nil "Hemlock ~A  "
    203203                                        *hemlock-version*)))
  • branches/event-ide/ccl/cocoa-ide/hemlock/src/modeline.lisp

    r7993 r7995  
    7171
    7272(make-modeline-field :name :hemlock-literal :width 8
    73                      :function #'(lambda (buffer window)
     73                     :function #'(lambda (buffer)
    7474                                   "Returns \"Hemlock \"."
    75                                    (declare (ignore buffer window))
     75                                   (declare (ignore buffer))
    7676                                   "Hemlock "))
    7777
    7878(make-modeline-field
    7979 :name :external-format
    80  :function #'(lambda (buffer window)
     80 :function #'(lambda (buffer)
    8181               "Returns an indication of buffer's external-format, iff it's
    8282other than :DEFAULT"
    83                (declare (ignore window))
    8483               (let* ((line-termination-string
    8584                       (case (buffer-line-termination buffer)
     
    9594(make-modeline-field
    9695 :name :package
    97  :function #'(lambda (buffer window)
     96 :function #'(lambda (buffer)
    9897               "Returns the value of buffer's \"Current Package\" followed
    9998                by a colon and two spaces, or a string with one space."
    100                (declare (ignore window))
    10199               (if (hemlock-bound-p 'hemlock::current-package :buffer buffer)
    102100                   (let ((val (variable-value 'hemlock::current-package
     
    111109(make-modeline-field
    112110 :name :modes
    113  :function #'(lambda (buffer window)
     111 :function #'(lambda (buffer)
    114112               "Returns buffer's modes followed by one space."
    115                (declare (ignore window))
    116113               (let* ((m ()))
    117114                 (dolist (mode (buffer-mode-objects buffer))
     
    124121(make-modeline-field
    125122 :name :modifiedp
    126  :function #'(lambda (buffer window)
     123 :function #'(lambda (buffer)
    127124               "Returns \"* \" if buffer is modified, or \"  \"."
    128                (declare (ignore window))
    129125               (let ((modifiedp (buffer-modified buffer)))
    130126                 (if modifiedp
     
    134130(make-modeline-field
    135131 :name :buffer-name
    136  :function #'(lambda (buffer window)
     132 :function #'(lambda (buffer)
    137133               "Returns buffer's name followed by a colon and a space if the
    138134                name is not derived from the buffer's pathname, or the empty
    139135                string."
    140                (declare (ignore window))
    141136               (let ((pn (buffer-pathname buffer))
    142137                     (name (buffer-name buffer)))
     
    159154        (note-modeline-change buffer)))))
    160155
    161 (defun buffer-pathname-ml-field-fun (buffer window)
     156(defun buffer-pathname-ml-field-fun (buffer)
    162157  "Returns the namestring of buffer's pathname if there is one.  When
    163158   \"Maximum Modeline Pathname Length\" is set, and the namestring is too long,
    164159   return a truncated namestring chopping off leading directory specifications."
    165   (declare (ignore window))
    166160  (let ((pn (buffer-pathname buffer)))
    167161    (if pn
     
    202196(make-modeline-field
    203197 :name :process-info
    204  :function #'(lambda (buffer window)
    205                (declare (ignore window))
     198 :function #'(lambda (buffer)
    206199               (hemlock-ext:buffer-process-description buffer)))
    207200
Note: See TracChangeset for help on using the changeset viewer.