Changeset 7528


Ignore:
Timestamp:
Oct 26, 2007, 2:09:36 AM (13 years ago)
Author:
gz
Message:

Got tired of restarting my lisp all the time, made various hemlock
printing functions bind the right magic context variables. (This is
way ugly but temporary, as the whole threading scheme needs to be replaced
by something less fragile anyway, and this can be cleaned up then).

I'm checking in Matt's patch for ticket #135, because it's in my sources,
it works, and whatever else might be wrong with it is better than the
original bug.

add find-not-attribute and reverse-find-not-attribute so I don't have
to remember which way the magic arg to find-attribute goes.

make region-to-string take an optional output-string argument, return
length as second value.

Implement hi:window-buffer, also add ordered-hemlock-windows (returns
a front-to-back list of hemlock windows).

Location:
trunk/ccl/cocoa-ide
Files:
4 edited

Legend:

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

    r7503 r7528  
    11271127
    11281128(objc:defmethod (#/mouseDown: :void) ((self hemlock-text-view) event)
    1129   (let* ((q (hemlock-frame-event-queue (#/window self))))
    1130     (hi::enqueue-key-event q #k"leftdown"))
     1129  (unless (logtest #$NSCommandKeyMask (#/modifierFlags event))
     1130    (let* ((q (hemlock-frame-event-queue (#/window self))))
     1131      (hi::enqueue-key-event q #k"leftdown")))
    11311132  (call-next-method event))
    11321133
     
    23132314        (when cache (buffer-cache-buffer cache))))))
    23142315
     2316(defmethod hi:window-buffer ((frame hemlock-frame))
     2317  (let* ((dc (#/sharedDocumentController ns:ns-document-controller))
     2318         (doc (#/documentForWindow: dc frame)))
     2319    ;; Sometimes doc is null.  Why?  What would cause a hemlock frame to
     2320    ;; not have a document?  (When it happened, there seemed to be a hemlock
     2321    ;; frame in (windows) that didn't correspond to any visible window).
     2322    (unless (%null-ptr-p doc)
     2323      (hemlock-document-buffer doc))))
     2324
     2325(defmethod hi:window-buffer ((pane text-pane))
     2326  (hi:window-buffer (#/window pane)))
     2327
     2328(defun ordered-hemlock-windows ()
     2329  (delete-if-not #'(lambda (win)
     2330                     (and (typep win 'hemlock-frame)
     2331                          (hi:window-buffer win)))
     2332                   (windows)))
     2333
    23152334(defmethod hi::document-panes ((document hemlock-editor-document))
    23162335  (let* ((ts (slot-value document 'textstorage))
  • trunk/ccl/cocoa-ide/hemlock/src/htext2.lisp

    r6602 r7528  
    2424
    2525
    26 (defun region-to-string (region)
     26(defun region-to-string (region &optional output-string)
    2727  "Returns a string containing the characters in the given Region."
    2828  (close-line)
    2929  (let* ((dst-length (count-characters region))
    30          (string (make-string dst-length))
     30         (string (if (and output-string
     31                          (<= dst-length (length output-string)))
     32                     output-string
     33                     (make-string dst-length)))
    3134         (start-mark (region-start region))
    3235         (end-mark (region-end region))
     
    5457            (setf (char string index) #\newline)
    5558            (setq index (1+ index)))))
    56     string))
     59    (values string dst-length)))
    5760
    5861
     
    380383
    381384(defun %print-whole-line (structure stream)
    382   (cond ((eq structure *open-line*)
    383          (write-string *open-chars* stream :end *left-open-pos*)
    384          (write-string *open-chars* stream :start *right-open-pos*
    385                        :end *line-cache-length*))
    386         (t
    387          (write-string (line-chars structure) stream))))
     385  (let* ((hi::*current-buffer* (line-buffer structure))
     386         (hi::*buffer-gap-context* (hi::buffer-gap-context hi::*current-buffer*)))
     387    (cond ((eq structure *open-line*)
     388           (write-string *open-chars* stream :end *left-open-pos*)
     389           (write-string *open-chars* stream :start *right-open-pos*
     390                         :end *line-cache-length*))
     391          (t
     392           (write-string (line-chars structure) stream)))))
    388393
    389394(defun %print-before-mark (mark stream)
    390   (if (mark-line mark)
    391       (let* ((line (mark-line mark))
    392              (chars (line-chars line))
    393              (charpos (mark-charpos mark))
    394              (length (line-length line)))
    395         (declare (simple-string chars))
    396         (cond ((or (> charpos length) (< charpos 0))
    397                (write-string "{bad mark}" stream))
    398               ((eq line *open-line*)
    399                (cond ((< charpos *left-open-pos*)
    400                       (write-string *open-chars* stream :end charpos))
    401                      (t
    402                       (write-string *open-chars* stream :end *left-open-pos*)
    403                       (let ((p (+ charpos (- *right-open-pos* *left-open-pos*))))
     395  (let* ((hi::*current-buffer* (line-buffer (mark-line mark)))
     396         (hi::*buffer-gap-context* (hi::buffer-gap-context hi::*current-buffer*)))
     397    (if (mark-line mark)
     398        (let* ((line (mark-line mark))
     399               (chars (line-chars line))
     400               (charpos (mark-charpos mark))
     401               (length (line-length line)))
     402          (declare (simple-string chars))
     403          (cond ((or (> charpos length) (< charpos 0))
     404                 (write-string "{bad mark}" stream))
     405                ((eq line *open-line*)
     406                 (cond ((< charpos *left-open-pos*)
     407                        (write-string *open-chars* stream :end charpos))
     408                       (t
     409                        (write-string *open-chars* stream :end *left-open-pos*)
     410                        (let ((p (+ charpos (- *right-open-pos* *left-open-pos*))))
     411                          (write-string *open-chars* stream  :start *right-open-pos*
     412                                        :end p)))))
     413                (t
     414                 (write-string chars stream :end charpos))))
     415        (write-string "{deleted mark}" stream))))
     416
     417
     418(defun %print-after-mark (mark stream)
     419  (let* ((hi::*current-buffer* (line-buffer (mark-line mark)))
     420         (hi::*buffer-gap-context* (hi::buffer-gap-context hi::*current-buffer*)))
     421    (if (mark-line mark)
     422        (let* ((line (mark-line mark))
     423               (chars (line-chars line))
     424               (charpos (mark-charpos mark))
     425               (length (line-length line)))
     426          (declare (simple-string chars))
     427          (cond ((or (> charpos length) (< charpos 0))
     428                 (write-string "{bad mark}" stream))
     429                ((eq line *open-line*)
     430                 (cond ((< charpos *left-open-pos*)
     431                        (write-string *open-chars* stream  :start charpos
     432                                      :end *left-open-pos*)
    404433                        (write-string *open-chars* stream  :start *right-open-pos*
    405                                       :end p)))))
    406               (t
    407                (write-string chars stream :end charpos))))
    408       (write-string "{deleted mark}" stream)))
    409 
    410 
    411 (defun %print-after-mark (mark stream)
    412   (if (mark-line mark)
    413       (let* ((line (mark-line mark))
    414              (chars (line-chars line))
    415              (charpos (mark-charpos mark))
    416              (length (line-length line)))
    417         (declare (simple-string chars))
    418         (cond ((or (> charpos length) (< charpos 0))
    419                (write-string "{bad mark}" stream))
    420               ((eq line *open-line*)
    421                (cond ((< charpos *left-open-pos*)
    422                       (write-string *open-chars* stream  :start charpos
    423                                     :end *left-open-pos*)
    424                       (write-string *open-chars* stream  :start *right-open-pos*
    425                                     :end *line-cache-length*))
    426                      (t
    427                       (let ((p (+ charpos (- *right-open-pos* *left-open-pos*))))
    428                         (write-string *open-chars* stream :start p
    429                                       :end *line-cache-length*)))))
    430               (t
    431                (write-string chars stream  :start charpos  :end length))))
    432       (write-string "{deleted mark}" stream)))
     434                                      :end *line-cache-length*))
     435                       (t
     436                        (let ((p (+ charpos (- *right-open-pos* *left-open-pos*))))
     437                          (write-string *open-chars* stream :start p
     438                                        :end *line-cache-length*)))))
     439                (t
     440                 (write-string chars stream  :start charpos  :end length))))
     441        (write-string "{deleted mark}" stream))))
    433442
    434443(defun %print-hline (structure stream d)
     
    440449(defun %print-hmark (structure stream d)
    441450  (declare (ignore d))
    442   (write-string "#<Hemlock Mark \"" stream)
    443   (%print-before-mark structure stream)
    444   (write-string "^" stream)
    445   (%print-after-mark structure stream)
    446   (write-string "\">" stream)) 
     451  (let ((hi::*current-buffer* (line-buffer (mark-line structure)))
     452        (hi::*buffer-gap-context* (hi::buffer-gap-context hi::*current-buffer*)))
     453    (write-string "#<Hemlock Mark \"" stream)
     454    (%print-before-mark structure stream)
     455    (write-string "^" stream)
     456    (%print-after-mark structure stream)
     457    (write-string "\">" stream)))
    447458
    448459(defvar *print-region* 10
     
    454465  (let* ((start (region-start region))
    455466         (end (region-end region))
     467         (hi::*current-buffer* (line-buffer (mark-line start)))
     468         (hi::*buffer-gap-context* (hi::buffer-gap-context hi::*current-buffer*))
    456469         (first-line (mark-line start))
    457470         (last-line (mark-line end)))
  • trunk/ccl/cocoa-ide/hemlock/src/package.lisp

    r7082 r7528  
    180180   #:unshadow-attribute
    181181   #:find-attribute
     182   #:find-not-attribute
    182183   #:reverse-find-attribute
     184   #:reverse-find-not-attribute
    183185   #:character-attribute-hooks
    184186   #:current-window
  • trunk/ccl/cocoa-ide/hemlock/src/syntax.lisp

    r6581 r7528  
    511511            (return (move-to-position mark charpos line))))))))))
    512512
     513(defun find-not-attribute (mark attribute)
     514  (find-attribute mark attribute #'zerop))
    513515
    514516
     
    578580          (when (rev-normal-find-attribute line nil charpos vector mask)
    579581            (return (move-to-position mark (1+ charpos) line))))))))))
     582
     583(defun reverse-find-not-attribute (mark attribute)
     584  (reverse-find-attribute mark attribute #'zerop))
Note: See TracChangeset for help on using the changeset viewer.