Changeset 7898


Ignore:
Timestamp:
Dec 12, 2007, 6:00:55 AM (17 years ago)
Author:
gz
Message:

Make mark-column take tabs into account so indenting works again.
Bind c-x c-g to abort.
Push point when start isearch so don't search from a random mark.
Comment out undone prompt-for-xxx fns so can see where used.
Move mark-absolute-position into hemlock, add move-to-absolute-position.
Combine shared code between edit-definition and grep, make them use
execute-in-cocoa-thread, other futzing about in that general area. (I am working
up to addressing the problem that too much happens before the target window is
created, so that any editor-errors have nowhere to go).

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

Legend:

Unmodified
Added
Removed

  • branches/event-ide/ccl/cocoa-ide/cocoa-editor.lisp

    r7862 r7898  
    321321;;; offset on the appropriate line.
    322322(defun move-hemlock-mark-to-absolute-position (mark cache abspos)
     323  ;; TODO: figure out if updating the cache matters, and if not, use hi:move-to-absolute-position.
    323324  (let* ((hi::*current-buffer* (buffer-cache-buffer cache)))
    324325    (multiple-value-bind (line idx) (update-line-cache-for-index cache abspos)
    325326      #+debug
    326327      (#_NSLog #@"Moving point from current pos %d to absolute position %d"
    327                :int (mark-absolute-position mark)
     328               :int (hi:mark-absolute-position mark)
    328329               :int abspos)
    329330      (hemlock::move-to-position mark idx line)
    330331      #+debug
    331       (#_NSLog #@"Moved mark to %d" :int (mark-absolute-position mark)))))
    332 
    333 ;;; Return the absolute position of the mark in the containing buffer.
    334 ;;; This doesn't use the caching mechanism, so it's always linear in the
    335 ;;; number of preceding lines.
    336 (defun mark-absolute-position (mark)
    337   (let* ((hi::*current-buffer* (hi::line-%buffer (hi::mark-line mark)))
    338          (pos (hi::mark-charpos mark)))
    339     (+ (hi::get-line-origin (hi::mark-line mark)) pos)))
     332      (#_NSLog #@"Moved mark to %d" :int (hi:mark-absolute-position mark)))))
    340333
    341334;;; Return the length of the abstract string, i.e., the number of
    … …  
    701694      (#/replaceCharactersInRange:withString: self r string))))
    702695
     696;; In theory (though not yet in practice) we allow for a buffer to be shown in multiple
     697;; windows, and any change to a buffer through one window has to be reflected in all of
     698;; them.  Once hemlock really supports multiple views of a buffer, it will have some
     699;; mechanims to ensure that.
     700;; In Cocoa, we get some messages for the buffer (i.e. the document or the textstorage)
     701;; with no reference to a view.  There used to be code here that tried to do special-
     702;; case stuff for all views on the buffer, but that's not necessary, because as long
     703;; as hemlock doesn't support it, there will only be one view, and as soon as hemlock
     704;; does support it, will take care of updating all other views.  So all we need is to
     705;; get our hands on one of the views and do whatever it is through it.
     706(defun front-view-for-buffer (buffer)
     707  (loop
     708     with win-arr =  (#/orderedWindows *NSApp*)
     709     for i from 0 below (#/count win-arr) as w = (#/objectAtIndex: win-arr i)
     710     thereis (and (eq (hemlock-buffer w) buffer) (hemlock-view w))))
     711
    703712(objc:defmethod (#/replaceCharactersInRange:withString: :void)
    704713    ((self hemlock-text-storage) (r :<NSR>ange) string)
    … …  
    709718         (length (pref r :<NSR>ange.length))
    710719         (lisp-string (if (> (#/length string) 0) (lisp-string-from-nsstring string)))
    711          ;; In theory (though not yet in practice) we allow for a buffer to be shown in multiple
    712          ;; windows, and this change has to affect all the windows.  That's true for all changes
    713          ;; to a buffer, so once hemlock supports multiple views of a buffer, it will have some
    714          ;; way to update all the views.  So just pick any one window here and let hemlock take
    715          ;; care of the rest.
    716          (view (loop for w in (windows) thereis (and (eq (hemlock-buffer w) buffer) (hemlock-view w)))))
     720         (view (front-view-for-buffer buffer)))
    717721    (when view
    718722      (hi::handle-hemlock-event view #'(lambda ()
    … …  
    10111015                     #+debug (#_NSLog #@"enable blink, forward")
    10121016                     (setf (text-view-blink-location self)
    1013                            (1- (mark-absolute-position temp))
     1017                           (1- (hi:mark-absolute-position temp))
    10141018                           (text-view-blink-enabled self) #$YES)))))
    10151019              ((eql (hi::previous-character point) #\))
    … …  
    10201024                     #+debug (#_NSLog #@"enable blink, backward")
    10211025                     (setf (text-view-blink-location self)
    1022                            (mark-absolute-position temp)
     1026                           (hi:mark-absolute-position temp)
    10231027                           (text-view-blink-enabled self) #$YES))))))))))
    10241028
    … …  
    12431247                            (hi::with-mark ((m2 m1))
    12441248                              (when (hemlock::list-offset m2 1)
    1245                                 (ns:init-ns-range r index (- (mark-absolute-position m2) index))
     1249                                (ns:init-ns-range r index (- (hi:mark-absolute-position m2) index))
    12461250                                (return-from HANDLED r))))
    12471251                           ((eql (hi::previous-character m1) #\))
    12481252                            (hi::with-mark ((m2 m1))
    12491253                              (when (hemlock::list-offset m2 -1)
    1250                                 (ns:init-ns-range r (mark-absolute-position m2) (- index (mark-absolute-position m2)))
     1254                                (ns:init-ns-range r (hi:mark-absolute-position m2) (- index (hi:mark-absolute-position m2)))
    12511255                                (return-from HANDLED r))))))))))))
    12521256       (call-next-method proposed g)
    … …  
    13231327             ;; In all cases, activate Hemlock selection.
    13241328             (unless still-selecting
    1325                 (let* ((pointpos (mark-absolute-position point))
     1329                (let* ((pointpos (hi:mark-absolute-position point))
    13261330                       (selection-end (+ location len))
    13271331                       (mark (hi::copy-mark point :right-inserting)))
    … …  
    20292033    (let* ((document (hi::buffer-document buffer))
    20302034           (textstorage (if document (slot-value document 'textstorage)))
    2031            (pos (mark-absolute-position (hi::region-start region)))
    2032            (n (- (mark-absolute-position (hi::region-end region)) pos)))
     2035           (pos (hi:mark-absolute-position (hi::region-start region)))
     2036           (n (- (hi:mark-absolute-position (hi::region-end region)) pos)))
    20332037      (perform-edit-change-notification textstorage
    20342038                                        (@selector #/noteHemlockAttrChangeAtPosition:length:)
    … …  
    20542058           (textstorage (if document (slot-value document 'textstorage))))
    20552059      (when textstorage
    2056         (let* ((pos (mark-absolute-position mark)))
     2060        (let* ((pos (hi:mark-absolute-position mark)))
    20572061          (when (eq (hi::mark-%kind mark) :left-inserting)
    20582062            ;; Make up for the fact that the mark moved forward with the insertion.
    … …  
    20712075            (perform-edit-change-notification textstorage
    20722076                                              (@selector #/noteHemlockModificationAtPosition:length:)
    2073                                               (mark-absolute-position mark)
     2077                                              (hi:mark-absolute-position mark)
    20742078                                              n)))))
    20752079 
    … …  
    20802084           (textstorage (if document (slot-value document 'textstorage))))
    20812085      (when textstorage
    2082         (let* ((pos (mark-absolute-position mark)))
     2086        (let* ((pos (hi:mark-absolute-position mark)))
    20832087          (perform-edit-change-notification textstorage
    20842088                                            (@selector #/noteHemlockDeletionAtPosition:length:)
    … …  
    22972301         (textstorage (slot-value self 'textstorage))
    22982302         (point (hi::buffer-point buffer))
    2299          (pointpos (mark-absolute-position point)))
     2303         (pointpos (hi:mark-absolute-position point)))
    23002304    (#/beginEditing textstorage)
    23012305    (#/edited:range:changeInLength:
    … …  
    26392643      ;; If point is not on screen, move it.
    26402644      (let* ((point (hi::current-point))
    2641              (point-pos (mark-absolute-position point)))
     2645             (point-pos (hi:mark-absolute-position point)))
    26422646        (multiple-value-bind (win-pos win-len) (window-visible-range tv)
    26432647          (unless (and (<= win-pos point-pos) (< point-pos (+ win-pos win-len)))
    … …  
    27632767         (hi::*current-buffer* buffer)
    27642768         (point (hi::buffer-point buffer))
    2765          (pointpos (mark-absolute-position point))
     2769         (pointpos (hi:mark-absolute-position point))
    27662770         (location pointpos)
    27672771         (len 0))
    … …  
    27692773      (let* ((mark (hi::buffer-%mark buffer)))
    27702774        (when mark
    2771           (let* ((markpos (mark-absolute-position mark)))
     2775          (let* ((markpos (hi:mark-absolute-position mark)))
    27722776            (if (< markpos pointpos)
    27732777              (setq location markpos len (- pointpos markpos))
    … …  
    28522856
    28532857
    2854 (defun find-definition-in-document (name indicator document)
    2855   (let* ((buffer (hemlock-document-buffer document))
    2856          (hi::*current-buffer* buffer))
    2857     (hemlock::find-definition-in-buffer buffer name indicator)))
    2858 
    2859 
    2860 (defstatic *edit-definition-id-map* (make-id-map))
    2861 
    2862 ;;; Need to force things to happen on the main thread.
    2863 (defclass cocoa-edit-definition-request (ns:ns-object)
    2864     ((name-id :foreign-type :int)
    2865      (info-id :foreign-type :int))
    2866   (:metaclass ns:+ns-object))
    2867 
    2868 (objc:defmethod #/initWithName:info:
    2869     ((self cocoa-edit-definition-request)
    2870      (name :int) (info :int))
    2871   (#/init self)
    2872   (setf (slot-value self 'name-id) name
    2873         (slot-value self 'info-id) info)
    2874   self)
    2875 
    2876 (objc:defmethod (#/editDefinition: :void)
    2877     ((self hemlock-document-controller) request)
    2878   (let* ((name (id-map-free-object *edit-definition-id-map* (slot-value request 'name-id)))
    2879          (info (id-map-free-object *edit-definition-id-map* (slot-value request 'info-id))))
    2880     (destructuring-bind (indicator . pathname) info
    2881       (let* ((namestring (native-translated-namestring pathname))
    2882              (url (#/initFileURLWithPath:
    2883                    (#/alloc ns:ns-url)
    2884                    (%make-nsstring namestring)))
    2885              (document (#/openDocumentWithContentsOfURL:display:error:
    2886                         self
    2887                         url
    2888                         nil
    2889                         +null-ptr+)))
    2890         (unless (%null-ptr-p document)
    2891           (if (= (#/count (#/windowControllers document)) 0)
    2892             (#/makeWindowControllers document))
    2893           (find-definition-in-document name indicator document)
    2894           (update-hemlock-selection (slot-value document 'textstorage))
    2895           (#/showWindows document))))))
     2858(defun cocoa-edit-definition (name info)
     2859  (assume-cocoa-thread)
     2860  (destructuring-bind (indicator . pathname) info
     2861    (invoke-in-file-buffer pathname #'(lambda ()
     2862                                        (hemlock::find-definition-in-buffer name indicator)))))
     2863
     2864(defun invoke-in-file-buffer (pathname thunk)
     2865  "Find file PATHNAME, and invoke thunk in it, typically to set initial selection"
     2866  (assume-cocoa-thread)
     2867  (let* ((namestring (native-translated-namestring pathname))
     2868         (url (#/initFileURLWithPath:
     2869               (#/alloc ns:ns-url)
     2870               (%make-nsstring namestring)))
     2871         (document (#/openDocumentWithContentsOfURL:display:error:
     2872                    (#/sharedDocumentController ns:ns-document-controller)
     2873                    url
     2874                    nil
     2875                    +null-ptr+)))
     2876    (when (%null-ptr-p document)
     2877      ;; TODO: get the system error message above!
     2878      (error "Couldn't open ~s" pathname))
     2879    #+GZ (log-debug "~&Opened Document ~s, buffer ~s, view ~s"
     2880                    document (hemlock-buffer document) (front-view-for-buffer (hemlock-buffer document)))
     2881    (when (= (#/count (#/windowControllers document)) 0)
     2882      (#/makeWindowControllers document))
     2883    (let* ((buffer (hemlock-buffer document))
     2884           (hi::*current-buffer* buffer))
     2885      (funcall thunk))
     2886    (update-hemlock-selection (slot-value document 'textstorage))
     2887    (#/showWindows document)))
    28962888
    28972889(defun hemlock-ext:edit-single-definition (name info)
    2898   (let* ((request (make-instance 'cocoa-edit-definition-request
    2899                                  :with-name (assign-id-map-id *edit-definition-id-map* name)
    2900                                  :info (assign-id-map-id *edit-definition-id-map* info))))
    2901     (#/performSelectorOnMainThread:withObject:waitUntilDone:
    2902      (#/sharedDocumentController ns:ns-document-controller)
    2903      (@selector #/editDefinition:)
    2904      request
    2905      t)))
    2906 
     2890  (execute-in-cocoa-thread #'(lambda () (cocoa-edit-definition name info))))
    29072891
    29082892(defun hemlock-ext:open-sequence-dialog (&key title sequence action (printer #'prin1))
    … …  
    29502934   t))
    29512935
    2952 
     2936(defmethod hemlock-edit-from-filename (file)
     2937  (assume-cocoa-thread)
     2938  (check-type file (or string pathname))
     2939  (let* ((document-controller (#/sharedDocumentController hemlock-document-controller)))
     2940    (let* ((url (pathname-to-url file))
     2941           ;; The default implementation of this method checks to see if the document is
     2942           ;; already open according to documentForURL:, and if it is not open determines
     2943           ;; the type of the document, invokes makeDocumentWithContentsOfURL:ofType:error:
     2944           ;; to instantiate it, then invokes addDocument: to record its opening, and sends
     2945           ;; the document makeWindowControllers and showWindows messages.  If the document
     2946           ;; is already open, it is just sent a showWindows message.
     2947           ;; If not successful, the method returns nil after setting outError to point to
     2948           ;; an NSError object that encapsulates the reason why the document could not be opened.
     2949           (doc (#/openDocumentWithContentsOfURL:display:error:
     2950                 document-controller
     2951                 url
     2952                 #$YES
     2953                 +null-ptr+)))
     2954      (when (%null-ptr-p doc)
     2955        ;; TODO: should pass in a place to put error and show here.
     2956        (error "Failed to open ~s" file)))))
     2957 
    29532958;;; Enable CL:ED
    29542959(defun cocoa-edit (&optional arg)
    … …  
    29642969           #+no (unless (probe-file arg)
    29652970                  (ccl::touch arg))
    2966            (with-autorelease-pool
    2967              (let* ((url (pathname-to-url arg))
    2968                     (signature (#/methodSignatureForSelector:
    2969                                 document-controller
    2970                                 (@selector #/openDocumentWithContentsOfURL:display:error:)))
    2971                     (invocation (#/invocationWithMethodSignature: ns:ns-invocation
    2972                                                                   signature)))
    2973              
    2974                (#/setTarget: invocation document-controller)
    2975                (#/setSelector: invocation (@selector #/openDocumentWithContentsOfURL:display:error:))
    2976                (rlet ((p :id)
    2977                       (q :<BOOL>)
    2978                       (perror :id +null-ptr+))
    2979                  (setf (pref p :id) url
    2980                        (pref q :<BOOL>) #$YES)
    2981                  (#/setArgument:atIndex: invocation p 2)
    2982                  (#/setArgument:atIndex: invocation q 3)
    2983                  (#/setArgument:atIndex: invocation perror 4)
    2984                  (#/performSelectorOnMainThread:withObject:waitUntilDone:
    2985                   invocation
    2986                   (@selector #/invoke)
    2987                   +null-ptr+
    2988                   t)))))
     2971           (execute-in-cocoa-thread #'(lambda () (hemlock-edit-from-filename arg))))
    29892972          ((ccl::valid-function-name-p arg)
    29902973           (hemlock::edit-definition arg))

  • branches/event-ide/ccl/cocoa-ide/cocoa-grep.lisp

    r7862 r7898  
    77(defvar *grep-program* "grep")
    88
    9 (defclass cocoa-edit-grep-line-request (ns:ns-object)
    10   ((file-id :foreign-type :int)
    11    (line-num :foreign-type :int))
    12   (:metaclass ns:+ns-object))
    13 
    14 (objc:defmethod #/initWithFile:line:
    15                 ((self cocoa-edit-grep-line-request) (file :int) (line :int))
    16   (#/init self)
    17   (setf (slot-value self 'file-id) file
    18         (slot-value self 'line-num) line)
    19   self)
    20 
    21 (objc:defmethod (#/editGrepLine: :void)
    22     ((self hemlock-document-controller) request)
    23   (let* ((file (id-map-free-object *edit-definition-id-map* (slot-value request 'file-id)))
    24          (line-num (slot-value request 'line-num))
    25          (namestring (native-translated-namestring file))
    26          (url (#/initFileURLWithPath:
    27                (#/alloc ns:ns-url)
    28                (%make-nsstring namestring)))
    29          (document (#/openDocumentWithContentsOfURL:display:error:
    30                     self
    31                     url
    32                     nil
    33                     +null-ptr+)))
    34     (unless (%null-ptr-p document)
    35       (when (= (#/count (#/windowControllers document)) 0)
    36         (#/makeWindowControllers document))
    37       (let* ((buffer (hemlock-document-buffer document))
    38              (hi::*current-buffer* buffer))
    39         (edit-grep-line-in-buffer line-num))
    40       (update-hemlock-selection (slot-value document 'textstorage))
    41       (#/showWindows document))))
     9(defun cocoa-edit-grep-line (file line-num)
     10  (assume-cocoa-thread)
     11  (invoke-in-file-buffer file #'(lambda ()
     12                                  (edit-grep-line-in-buffer line-num))))
    4213
    4314(defun edit-grep-line-in-buffer (line-num)
    … …  
    6031  (multiple-value-bind (file line-num) (parse-grep-line line)
    6132    (when file
    62       (let* ((request (make-instance 'cocoa-edit-grep-line-request
    63                                      :with-file (assign-id-map-id *edit-definition-id-map* file)
    64                                      :line line-num)))
    65         (#/performSelectorOnMainThread:withObject:waitUntilDone:
    66          (#/sharedDocumentController ns:ns-document-controller)
    67          (@selector #/editGrepLine:)
    68          request
    69          t)))))
     33      (execute-in-cocoa-thread #'(lambda ()
     34                                   (cocoa-edit-grep-line file line-num))))))
    7035
    7136(defun grep-comment-line-p (line)

  • branches/event-ide/ccl/cocoa-ide/cocoa-listener.lisp

    r7862 r7898  
    371371         (protected-region (hi::buffer-protected-region buffer)))
    372372    (if protected-region
    373       (let* ((prot-start (mark-absolute-position (hi::region-start protected-region)))
    374              (prot-end (mark-absolute-position (hi::region-end protected-region))))
     373      (let* ((prot-start (hi:mark-absolute-position (hi::region-start protected-region)))
     374             (prot-end (hi:mark-absolute-position (hi::region-end protected-region))))
    375375        (not (or (and (>= range-start prot-start)
    376376                      (< range-start prot-end))

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/bindings.lisp

    r7844 r7898  
    8383(bind-key "Abort Command" #k"control-g")
    8484(bind-key "Abort Command" #k"control-G")
     85(bind-key "Abort Command" #k"control-x control-g")
     86(bind-key "Abort Command" #k"control-x control-G")
     87
    8588
    8689(bind-key "Process File Options" #k"control-x m" :global)

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/cocoa-hemlock.lisp

    r7844 r7898  
    7575      (format t "~& style ~d ~d [~s]/ ~d [~s] ~a"
    7676              (font-mark-font start)
    77               (gui::mark-absolute-position start)
     77              (mark-absolute-position start)
    7878              (mark-%kind start)
    79               (gui::mark-absolute-position end)
     79              (mark-absolute-position end)
    8080              (mark-%kind end)
    8181              (eq r (buffer-active-font-region buffer))))))

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/echo.lisp

    r7862 r7898  
    494494   :help help))
    495495
     496#+not-yet
    496497(defun prompt-for-y-or-n (&key ((:must-exist must-exist) t)
    497498                               (default nil defaultp)
    … …  
    526527;;;; Key-event and key prompting.
    527528
     529#+not-yet
    528530(defun prompt-for-key-event (&key (prompt "Key-event: ") (change-window t))
    529531  "Prompts for a key-event."
    530   (prompt-for-key-event* prompt change-window))
    531 
    532 (defun prompt-for-key-event* (prompt change-window)
    533532  (if change-window
    534533    (with-echo-area-window
    … …  
    539538     (recursive-get-key-event *editor-input* t))))
    540539
     540#+not-yet
    541541(defun prompt-for-key (&key ((:must-exist must-exist) t)
    542542                            default default-string
    … …  
    587587     (force-output *echo-area-stream*))))
    588588
     589#+not-yet
    589590(defun prompt-for-command-key ()
    590591  (with-echo-area-window
    … …  
    599600           (unless (eq res :prefix)
    600601             (return (values (copy-seq prompt-key) res)))))))))
    601 
    602602
    603603

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/edit-defs.lisp

    r7883 r7898  
    296296           (match-context-for-indicator start end package indicator)))))
    297297   
    298 (defun find-definition-in-buffer (buffer name indicator)
    299   (setf (hi::buffer-region-active buffer) nil)
    300   (when (symbolp name)
    301     (let* ((string (string name))
    302            (len (length string))
    303            (pattern (get-search-pattern (string name) :forward))
    304            (mark (copy-mark (buffer-start-mark buffer)))
    305            (package (or
    306                      (find-package
    307                       (variable-value 'current-package :buffer buffer))
    308                      *package*)))
    309       (or
    310        (loop
    311          (let* ((won (find-pattern mark pattern)))
    312            (unless won
    313              (return))
    314            (when (match-definition-context mark name indicator package)
    315              (backward-up-list mark)
    316              (move-mark (buffer-point buffer) mark)
    317              (return t))
    318           (unless (character-offset mark len)
    319             (return))))
    320        (beep)))))
     298(defun find-definition-in-buffer (name indicator)
     299  (let ((buffer (current-buffer)))
     300    (setf (hi::buffer-region-active buffer) nil)
     301    (when (symbolp name)
     302      (let* ((string (string name))
     303             (len (length string))
     304             (pattern (get-search-pattern (string name) :forward))
     305             (mark (copy-mark (buffer-start-mark buffer)))
     306             (package (or
     307                       (find-package
     308                        (variable-value 'current-package :buffer buffer))
     309                       *package*)))
     310        (or
     311         (loop
     312           (let* ((won (find-pattern mark pattern)))
     313             (unless won
     314               (return))
     315             (when (match-definition-context mark name indicator package)
     316               (backward-up-list mark)
     317               (move-mark (buffer-point buffer) mark)
     318               (return t))
     319             (unless (character-offset mark len)
     320               (return))))
     321         (beep))))))

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/htext1.lisp

    r7844 r7898  
    439439    mark))
    440440
     441(defun mark-absolute-position (mark)
     442  (+ (get-line-origin (mark-line mark))
     443     (mark-charpos mark)))
     444
     445(defun move-to-absolute-position (mark position)
     446  (with-mark ((m (buffer-start-mark (mark-buffer mark))))
     447    (when (character-offset m position)
     448      (move-mark mark m))))
     449
     450(defun mark-column (mark)
     451  (let ((column 0)
     452        (tab-spaces (value hemlock::spaces-per-tab))
     453        (line (mark-line mark))
     454        (charpos (mark-charpos mark)))
     455    (multiple-value-bind (chars gap-start gap-end)
     456                         (if (current-open-line-p line)
     457                           (values (current-open-chars)
     458                                   (current-left-open-pos)
     459                                   (current-right-open-pos))
     460                           (values (line-chars line) charpos charpos))
     461      (when (< gap-start charpos)
     462        (incf charpos (- gap-end gap-start)))
     463      (loop with pos = 0
     464        do (when (eql pos gap-start) (setq pos gap-end))
     465        while (< pos charpos)
     466        do (incf column (if (eql (schar chars pos) #\tab)
     467                          (- tab-spaces (mod column tab-spaces))
     468                          1))
     469        do (incf pos))
     470      column)))
     471
     472
    441473
    442474;;;; Regions.

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/isearchcoms.lisp

    r7844 r7898  
    133133  (let* ((iss (make-isearch-state :direction direction
    134134                                  :start-region (current-region-info))))
     135    (push-buffer-mark (copy-mark (current-point)))
    135136    (setf (value i-search-state) iss)
    136137    (%i-search-message iss)))

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/morecoms.lisp

    r7844 r7898  
    356356    (let ((point (current-point-unless-selection)))
    357357      (when point
    358         (with-mark ((m point))
    359           (unless (character-offset (buffer-start m) p)
    360             (buffer-end m))
    361           (move-mark point m))))))
     358        (unless (move-to-absolute-position point p)
     359          (buffer-end point))))))
    362360
    363361(defcommand "What Cursor Position" (p)
    … …  
    366364  (declare (ignore p))
    367365  (let* ((point (current-point))
    368          (current-line (mark-line point)))
    369     (let* ((line-number (do* ((l 1 (1+ l))
    370                               (mark-line (line-previous (mark-line point)) (line-previous mark-line)))
    371                              ((null mark-line) l)))
    372              (charpos (mark-charpos point))
    373              (abspos (+ (hi::get-line-origin current-line) charpos))
    374              (char (next-character point))
    375              (size (count-characters (buffer-region (current-buffer)))))
    376         (message "Char: ~s point = ~d of ~d(~d%) line ~d column ~d"
    377                  char abspos size (round (/ (* 100 abspos) size)) line-number charpos))))
    378 
     366         (line-number (do* ((l 1 (1+ l))
     367                            (mark-line (line-previous (mark-line point)) (line-previous mark-line)))
     368                           ((null mark-line) l)))
     369         (charpos (mark-charpos point))
     370         (abspos (mark-absolute-position point))
     371         (char (next-character point))
     372         (size (count-characters (buffer-region (current-buffer)))))
     373    (message "Char: ~s point = ~d of ~d(~d%) line ~d column ~d"
     374             char abspos size (round (/ (* 100 abspos) size)) line-number charpos)))
    379375
    380376;;;; Page commands & stuff.

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/package.lisp

    r7862 r7898  
    3131   #:mark-kind
    3232   #:mark-buffer
     33   #:mark-absolute-position
    3334   #:previous-character
    3435   #:next-character
    … …  
    3738   #:delete-mark
    3839   #:move-to-position
     40   #:move-to-absolute-position
    3941   #:move-mark
    4042   #:line-start
    … …  
    505507   ;; htext1.lisp
    506508   #:line-length #:line-buffer #:line-string #:line-character #:mark #:mark-kind
    507    #:copy-mark #:delete-mark #:move-to-position #:region #:make-empty-region
     509   #:copy-mark #:delete-mark #:move-to-position #:mark-absolute-position
     510   #:move-to-absolute-position #:region #:make-empty-region
    508511   #:start-line-p #:end-line-p #:empty-line-p #:blank-line-p #:blank-before-p
    509512   #:blank-after-p #:same-line-p #:mark< #:mark<= #:mark> #:mark>= #:mark= #:mark/=

  • branches/event-ide/ccl/cocoa-ide/hemlock/src/struct.lisp

    r7844 r7898  
    3737  following the mark.")
    3838
    39 ;; This used to return window position, but for now that's disabled.
    40 (defun mark-column (mark)
    41   (mark-charpos mark))
    4239
    4340(defstruct (font-mark (:print-function
Note: See TracChangeset for help on using the changeset viewer.