Changeset 716
- Timestamp:
- Mar 24, 2004, 12:51:49 AM (21 years ago)
- File:
-
- 1 edited
-
trunk/ccl/examples/cocoa-editor.lisp (modified) (28 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/ccl/examples/cocoa-editor.lisp
r707 r716 136 136 buffer-p)) 137 137 (when buffer-p (setf (buffer-cache-buffer d) buffer)) 138 (let* ((workline (hemlock::mark-line 139 (hemlock::buffer-start-mark buffer)))) 138 (let* ((hi::*buffer-gap-context* (hi::buffer-gap-context buffer)) 139 (workline (hi::mark-line 140 (hi::buffer-start-mark buffer)))) 140 141 (setf (buffer-cache-buflen d) (hemlock-buffer-length buffer) 141 142 (buffer-cache-workline-offset d) 0 142 143 (buffer-cache-workline d) workline 143 (buffer-cache-workline-length d) (h emlock::line-length workline)144 (buffer-cache-workline-length d) (hi::line-length workline) 144 145 (buffer-cache-workline-start-font-index d) 0) 145 146 d)) … … 149 150 ;;; position. 150 151 (defun update-line-cache-for-index (cache index) 151 (let* ((line (or 152 (let* ((buffer (buffer-cache-buffer cache)) 153 (hi::*buffer-gap-context* (hi::buffer-gap-context buffer)) 154 (line (or 152 155 (buffer-cache-workline cache) 153 156 (progn … … 168 171 (setq moved t) 169 172 (if (< index pos) 170 (setq line (h emlock::line-previous line)171 len (h emlock::line-length line)173 (setq line (hi::line-previous line) 174 len (hi::line-length line) 172 175 pos (1- (- pos len))) 173 (setq line (h emlock::line-next line)176 (setq line (hi::line-next line) 174 177 pos (1+ (+ pos len)) 175 len (h emlock::line-length line))))))178 len (hi::line-length line)))))) 176 179 177 180 ;;; Ask Hemlock to count the characters in the buffer. 178 181 (defun hemlock-buffer-length (buffer) 179 ( hi::with-buffer-gap-info (buffer)182 (let* ((hi::*buffer-gap-context* (hi::buffer-gap-context buffer))) 180 183 (hemlock::count-characters (hemlock::buffer-region buffer)))) 181 184 … … 184 187 ;;; in that line or the trailing #\newline, as appropriate. 185 188 (defun hemlock-char-at-index (cache index) 186 (hi::with-buffer-gap-info ((buffer-cache-buffer cache)) 189 (let* ((hi::*buffer-gap-context* 190 (hi::buffer-gap-context (buffer-cache-buffer cache)))) 187 191 (multiple-value-bind (line idx) (update-line-cache-for-index cache index) 188 192 (let* ((len (hemlock::line-length line))) … … 194 198 ;;; offset on the appropriate line. 195 199 (defun move-hemlock-mark-to-absolute-position (mark cache abspos) 196 (hi::with-buffer-gap-info ((buffer-cache-buffer cache)) 200 (let* ((hi::*buffer-gap-context* 201 (hi::buffer-gap-context (buffer-cache-buffer cache)))) 197 202 (multiple-value-bind (line idx) (update-line-cache-for-index cache abspos) 198 (hemlock::move-to-position mark idx line)))) 203 #+debug 204 (#_NSLog #@"Moving point from current pos %d to absolute position %d" 205 :int (mark-absolute-position mark) 206 :int abspos) 207 (hemlock::move-to-position mark idx line) 208 #+debug 209 (#_NSLog #@"Moved mark to %d" :int (mark-absolute-position mark))))) 199 210 200 211 ;;; Return the absolute position of the mark in the containing buffer. … … 202 213 ;;; number of preceding lines. 203 214 (defun mark-absolute-position (mark) 204 (hi::with-buffer-gap-info ((hi::line-%buffer (hi::mark-line mark))) 205 (let* ((pos (hi::mark-charpos mark))) 206 (do* ((line (hi::line-previous (hi::mark-line mark)) 207 (hi::line-previous line))) 208 ((null line) pos) 209 (incf pos (1+ (hi::line-length line))))))) 215 (let* ((pos (hi::mark-charpos mark))) 216 (do* ((line (hi::line-previous (hi::mark-line mark)) 217 (hi::line-previous line))) 218 ((null line) pos) 219 (incf pos (1+ (hi::line-length line)))))) 210 220 211 221 ;;; Return the length of the abstract string, i.e., the number of … … 217 227 (setf (buffer-cache-buflen cache) 218 228 (let* ((buffer (buffer-cache-buffer cache))) 219 (hi::with-buffer-gap-info (buffer) 220 (hemlock-buffer-length buffer))))))) 229 (hemlock-buffer-length buffer)))))) 221 230 222 231 … … 236 245 hemlock-buffer-string) 237 246 (let* ((buffer (buffer-cache-buffer (hemlock-buffer-string-cache self))) 247 (hi::*buffer-gap-context* (hi::buffer-gap-context buffer)) 238 248 (external-format (if buffer (hi::buffer-external-format buffer ))) 239 249 (raw-length (if buffer (hemlock-buffer-length buffer) 0))) … … 291 301 ;;; hemlock-text-storage objects 292 302 (defclass hemlock-text-storage (ns:ns-text-storage) 293 ((string :foreign-type :id)) 303 ((string :foreign-type :id) 304 (edit-count :foreign-type :int)) 294 305 (:metaclass ns:+ns-object)) 306 307 (define-objc-method ((:void begin-editing) hemlock-text-storage) 308 #+debug 309 (#_NSLog #@"begin-editing") 310 (incf (slot-value self 'edit-count)) 311 (send-super 'begin-editing)) 312 313 (define-objc-method ((:void end-editing) hemlock-text-storage) 314 #+debug 315 (#_NSLog #@"end-editing") 316 (send-super 'end-editing) 317 (decf (slot-value self 'edit-count))) 318 319 ;;; Return true iff we're inside a "beginEditing/endEditing" pair 320 (define-objc-method ((:<BOOL> editing-in-progress) hemlock-text-storage) 321 (not (eql (slot-value self 'edit-count) 0))) 322 323 295 324 296 325 ;;; Access the string. It'd be nice if this was a generic function; … … 308 337 ;;; hemlock-buffer-string.) 309 338 (defun make-textstorage-for-hemlock-buffer (buffer) 339 (unless (hi::buffer-gap-context buffer) 340 (setf (hi::buffer-gap-context buffer) (hi::make-buffer-gap-context))) 310 341 (make-objc-instance 'hemlock-text-storage 311 342 :with-string … … 336 367 :with-string string) 337 368 hemlock-text-storage) 369 #+debug 338 370 (#_NSLog #@"replace-characters-in-range (%d %d) with-string %@" 339 371 :unsigned (pref r :<NSR>ange.location) … … 346 378 :range (:<NSR>ange r)) 347 379 hemlock-text-storage) 380 #+debug 348 381 (#_NSLog #@"set-attributes %@ range (%d %d)" 349 382 :id attributes … … 382 415 (let* ((string (send self 'string)) 383 416 (buffer (buffer-cache-buffer (hemlock-buffer-string-cache string))) 417 (hi::*buffer-gap-context* (hi::buffer-gap-context buffer)) 384 418 (point (hi::buffer-point buffer)) 385 419 (pos (mark-absolute-position point))) 420 #+debug 421 (#_NSLog #@"update Hemlock selection: charpos = %d, abspos = %d" 422 :int (hi::mark-charpos point) :int pos) 386 423 (for-each-textview-using-storage 387 424 self 388 425 #'(lambda (tv) 389 426 (slet ((selection (ns-make-range pos 0))) 390 (send tv :set-selected-range selection)))))) 427 #+debug 428 (#_NSLog #@"Setting selection to %d" :int pos) 429 (send tv :set-selected-range selection)))))) 391 430 392 431 … … 489 528 :still-selecting (:<BOOL> still-selecting)) 490 529 hemlock-text-view) 491 (let* ((d (hemlock-buffer-string-cache (send self 'string))) 530 (unless (send (send self 'text-storage) 'editing-in-progress) 531 (let* ((d (hemlock-buffer-string-cache (send self 'string))) 492 532 (point (hemlock::buffer-point (buffer-cache-buffer d))) 493 533 (location (pref r :<NSR>ange.location)) 494 534 (len (pref r :<NSR>ange.length))) 495 535 (when (eql len 0) 496 (move-hemlock-mark-to-absolute-position point d location)) 497 (send-super :set-selected-range r 498 :affinity affinity 499 :still-selecting still-selecting))) 536 #+debug 537 (#_NSLog #@"Moving point to absolute position %d" :int location) 538 (move-hemlock-mark-to-absolute-position point d location)))) 539 (send-super :set-selected-range r 540 :affinity affinity 541 :still-selecting still-selecting)) 500 542 501 543 … … 762 804 (defloadvar *hemlock-frame-count* 0) 763 805 764 (defun make-echo-area (hemlock-frame x y width height )806 (defun make-echo-area (hemlock-frame x y width height gap-context) 765 807 (slet ((frame (ns-make-rect x y width height)) 766 808 (containersize (ns-make-size 1.0f7 height))) … … 770 812 (incf *hemlock-frame-count*))) 771 813 :modes '("Echo Area"))) 772 (textstorage (make-textstorage-for-hemlock-buffer buffer)) 814 (textstorage 815 (progn 816 (setf (hi::buffer-gap-context buffer) gap-context) 817 (make-textstorage-for-hemlock-buffer buffer))) 773 818 (doc (make-objc-instance 'echo-area-document)) 774 819 (layout (make-objc-instance 'ns-layout-manager)) … … 797 842 echo)))) 798 843 799 (defun make-echo-area-for-window (w )844 (defun make-echo-area-for-window (w gap-context-for-echo-area-buffer) 800 845 (let* ((content-view (send w 'content-view))) 801 846 (slet ((bounds (send content-view 'bounds))) 802 (let* ((echo-area (make-echo-area w 5.0f0 5.0f0 (- (pref bounds :<NSR>ect.size.width) 24.0f0) 15.0f0 )))847 (let* ((echo-area (make-echo-area w 5.0f0 5.0f0 (- (pref bounds :<NSR>ect.size.width) 24.0f0) 15.0f0 gap-context-for-echo-area-buffer))) 803 848 (send content-view :add-subview echo-area) 804 849 echo-area)))) … … 824 869 (hi::*echo-area-stream* (hi::make-hemlock-output-stream 825 870 (hi::region-end region) :full)) 871 (hi::*parse-starting-mark* 872 (hi::copy-mark (hi::buffer-point hi::*echo-area-buffer*) 873 :right-inserting)) 874 (hi::*parse-input-region* 875 (hi::region hi::*parse-starting-mark* 876 (hi::region-end region))) 826 877 (hi::*cache-modification-tick* -1) 827 878 (hi::now-tick 0) … … 830 881 (hi::*last-key-event-typed* nil) 831 882 (hi::*input-transcript* nil) 832 (hi::*line-cache-length* 200) 833 (hi::*open-line* nil) 834 (hi::*open-chars* (make-string hi::*line-cache-length* )) 835 (hi::*left-open-pos* 0) 836 (hi::*right-open-pos* 0) 883 (hi::*buffer-gap-context* (hi::buffer-gap-context buffer)) 837 884 (hemlock::*target-column* 0) 838 885 (hemlock::*last-comment-start* 0) … … 842 889 ) 843 890 (setf (hi::current-buffer) buffer) 844 (hi::%command-loop))) 891 (unwind-protect 892 (loop 893 (catch 'editor-top-level-catcher 894 (handler-bind ((error #'(lambda (condition) 895 (lisp-error-error-handler condition 896 :internal)))) 897 (invoke-hook hemlock::abort-hook) 898 (%command-loop)))) 899 (invoke-hook hemlock::exit-hook)))) 845 900 846 901 … … 855 910 (let* ((w (new-cocoa-window :class (find-class 'hemlock-frame) 856 911 :activate nil))) 857 (setf (slot-value w 'echo-area-view)858 (make-echo-area-for-window w))859 912 (values w (add-pane-to-window w :reserve-below 20.0)))) 860 913 … … 887 940 888 941 889 (defun read-file-to-hemlock-buffer (path) 890 (hemlock::find-file-buffer path)) 942 891 943 892 944 (defun hemlock-buffer-from-nsstring (nsstring name &rest modes) … … 974 1026 (frame (send pane 'window)) 975 1027 (buffer (text-view-buffer (text-pane-text-view pane)))) 1028 (setf (slot-value frame 'echo-area-view) 1029 (make-echo-area-for-window frame (hi::buffer-gap-context buffer))) 976 1030 (setf (slot-value frame 'command-thread) 977 1031 (process-run-function (format nil "Hemlock window thread") … … 1023 1077 1024 1078 (defun textstorage-note-insertion-at-position (textstorage pos n) 1079 #+debug 1080 (#_NSLog #@"insertion at position %d, len %d" :int pos :int n) 1025 1081 (send textstorage 1026 1082 :edited #$NSTextStorageEditedAttributes … … 1032 1088 :change-in-length 0)) 1033 1089 1090 1091 (defun hi::buffer-note-modification (buffer mark n) 1092 (when (hi::bufferp buffer) 1093 (let* ((document (hi::buffer-document buffer)) 1094 (textstorage (if document (slot-value document 'textstorage)))) 1095 (when textstorage 1096 (let* ((pos (mark-absolute-position mark))) 1097 '(let* ((display (hemlock-buffer-string-cache (send textstorage 'string)))) 1098 (reset-buffer-cache display) 1099 (update-line-cache-for-index display pos)) 1100 #+debug 1101 (#_NSLog #@"Modification at %d, len %d" :int pos :int n) 1102 (send textstorage 1103 :edited (logior 1104 #$NSTextStorageEditedCharacters 1105 #$NSTextStorageEditedAttributes) 1106 :range (ns-make-range pos n) 1107 :change-in-length 0)) 1108 (sleep .1)) 1109 ))) 1110 1111 1034 1112 (defun hi::buffer-note-insertion (buffer mark n) 1035 1113 (when (hi::bufferp buffer) … … 1058 1136 #+debug 1059 1137 (format t "~& pos = ~d, n = ~d" pos n) 1138 #+debug 1060 1139 (force-output) 1061 1140 (send textstorage … … 1141 1220 (setf (slot-value doc 'textstorage) 1142 1221 (make-textstorage-for-hemlock-buffer buffer) 1222 (hi::buffer-gap-context buffer) (hi::make-buffer-gap-context) 1143 1223 (hi::buffer-document buffer) doc))) 1144 1224 doc)) … … 1156 1236 (setf (hi::buffer-pathname b) pathname) 1157 1237 (setf (slot-value self 'textstorage) 1158 (make-textstorage-for-hemlock-buffer b)) 1238 (make-textstorage-for-hemlock-buffer b) 1239 (hi::buffer-gap-context b) 1240 (hi::make-buffer-gap-context)) 1159 1241 b))) 1160 1242 (data (make-objc-instance 'ns:ns-data
Note:
See TracChangeset
for help on using the changeset viewer.
