[Openmcl-cvs-notifications] r12558 - /trunk/source/cocoa-ide/hemlock-text.lisp

[rme at clozure.com]

Author: rme
Date: Sat Aug  8 01:52:53 2009
New Revision: 12558

Log:
Add #/getCharacters:range: for xhemlock-buffer-string.

Modified:
    trunk/source/cocoa-ide/hemlock-text.lisp

Modified: trunk/source/cocoa-ide/hemlock-text.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/cocoa-ide/hemlock-text.lisp (original)
+++ trunk/source/cocoa-ide/hemlock-text.lisp Sat Aug  8 01:52:53 2009
@@ -93,6 +93,32 @@
 	  (if (< code #x10000)
 	    code
 	    #\Replacement_Character))))))
+
+(objc:defmethod (#/getCharacters:range: :void) ((self xhemlock-buffer-stri=
ng)
+						(buffer (:* :unichar))
+						(r :<NSR>ange))
+  (let* ((cache (hemlock-buffer-string-cache self))
+         (index (ns:ns-range-location r))
+         (length (ns:ns-range-length r))
+         (hi::*current-buffer* (buffer-cache-buffer cache)))
+    #+debug
+    (#_NSLog #@"get characters: %d/%d"
+             :<NSUI>nteger index
+             :<NSUI>nteger length)
+    (multiple-value-bind (line idx) (update-line-cache-for-index cache ind=
ex)
+      (let* ((len (hemlock::line-length line)))
+        (do* ((i 0 (1+ i)))
+             ((=3D i length))
+          (cond ((< idx len)
+                 (setf (paref buffer (:* :unichar) i)
+                       (char-code (hemlock::line-character line idx)))
+                 (incf idx))
+                (t
+                 (setf (paref buffer (:* :unichar) i)
+                       (char-code #\Newline)
+                       line (hi::line-next line)
+                       len (if line (hi::line-length line) 0)
+                       idx 0))))))))
 =0C
 =

 ;;; This is bound to T when we edit text using the methods of
@@ -361,8 +387,6 @@
             (:ns-character-shap (format t "~s" keyword))
             (:ns-glyph-info (format t "~s" keyword))))))))
 =

-      =

-
 (defun charprops-to-dict (plist)
   (when (null plist)
     (return-from charprops-to-dict