Changeset 7913


Ignore:
Timestamp:
Dec 14, 2007, 4:26:09 PM (17 years ago)
Author:
gz
Message:

add push-NEW-buffer-mark, like (push-buffer-mark (copy-mark ..))

Location:
branches/event-ide/ccl/cocoa-ide/hemlock/src
Files:
11 edited

Legend:

Unmodified
Added
Removed

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

    r7844 r7913  
    331331    ;; establish a new (empty) region at point.
    332332    (unless (%buffer-current-region-p b)
    333       (push-buffer-mark (copy-mark point) t))
     333      (push-new-buffer-mark point t))
    334334    point))
    335335

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

    r7844 r7913  
    307307  "Sets the current region from point to the end of the buffer."
    308308  (declare (ignore p))
    309   (push-buffer-mark (buffer-end (copy-mark (current-point))) t))
     309  (buffer-end (push-new-buffer-mark (current-point) t)))
    310310
    311311(defcommand "Mark to Beginning of Buffer" (p)
    … …  
    313313  "Sets the current region from the beginning of the buffer to point."
    314314  (declare (ignore p))
    315   (push-buffer-mark (buffer-start (copy-mark (current-point))) t))
     315  (buffer-start (push-new-buffer-mark (current-point) t)))
    316316
    317317(defcommand "Beginning of Buffer" (p)
    … …  
    320320  (declare (ignore p))
    321321  (let ((point (current-point-collapsing-selection)))
    322     (push-buffer-mark (copy-mark point))
     322    (push-new-buffer-mark point)
    323323    (buffer-start point)))
    324324
    … …  
    328328  (declare (ignore p))
    329329  (let ((point (current-point-collapsing-selection)))
    330     (push-buffer-mark (copy-mark point))
     330    (push-new-buffer-mark point)
    331331    (buffer-end point)))
    332332

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

    r7911 r7913  
    151151                              (string-upcase name) *last-go-to-def-string*)))
    152152          (if (eq buffer (current-buffer))
    153               (push-buffer-mark (copy-mark point)))
     153              (push-new-buffer-mark point))
    154154          (move-mark point def-mark))))
    155155     (t
    … …  
    161161             (string-upcase name) *last-go-to-def-string*))
    162162          (let ((point (current-point)))
    163             (push-buffer-mark (copy-mark point))
     163            (push-new-buffer-mark point)
    164164            (move-mark point m))))))))
    165165|#

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

    r7911 r7913  
    278278         (region (region start end)))
    279279    (setv pathname-defaults pn)
    280     (push-buffer-mark (copy-mark end))
     280    (push-new-buffer-mark end)
    281281    (read-file pn end)
    282282    (make-region-undo :delete "Insert File" region)))

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

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

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

    r7844 r7913  
    145145  (%buffer-push-buffer-mark (current-buffer) mark activate-region))
    146146
     147(defun push-new-buffer-mark (mark &optional (activate-region nil))
     148  "Pushes a new mark at argument position"
     149  (push-buffer-mark (copy-mark mark :right-inserting) activate-region))
    147150
    148151(defcommand "Set/Pop Mark" (p)
    … …  
    154157  "Set or Pop the mark ring."
    155158  (cond ((not p)
    156          (push-buffer-mark (copy-mark (current-point)) t)
     159         (push-new-buffer-mark (current-point) t)
    157160         (message "Mark pushed."))
    158161        ((= p (value universal-argument-default))
    … …  
    197200         (end (region-end region))
    198201         (point (current-point)))
    199     (push-buffer-mark (copy-mark point))
    200     (cond (p (push-buffer-mark (copy-mark start) t)
     202    (push-new-buffer-mark point)
     203    (cond (p (push-new-buffer-mark start t)
    201204             (move-mark point end))
    202           (t (push-buffer-mark (copy-mark end) t)
     205          (t (push-new-buffer-mark end t)
    203206             (move-mark point start)))))
    204207
    … …  
    474477           (let* ((region (ring-ref *kill-ring* idx))
    475478                  (point (current-point-for-insertion))
    476                   (mark (copy-mark point)))
    477              (push-buffer-mark mark)
     479                  (mark (push-new-buffer-mark point)))
    478480             (insert-region point region)
    479481             (make-region-undo :delete "Un-Kill"

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

    r7911 r7913  
    14111411    (pre-command-parse-check m)
    14121412    (let ((count (or p 1))
    1413           (mark (push-buffer-mark (copy-mark m) t)))
     1413          (mark (push-new-buffer-mark m t)))
    14141414      (if (form-offset m count)
    14151415          (move-mark mark m)
    … …  
    14301430            (t
    14311431             (move-mark point start)
    1432              (move-mark (push-buffer-mark (copy-mark point) t) end))))))
     1432             (move-mark (push-new-buffer-mark point t) end))))))
    14331433
    14341434(defcommand "Forward Kill Form" (p)

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

    r7844 r7913  
    398398                        (region (copy-mark start) (copy-mark end))))))
    399399      (buffer-end point)
    400       (push-buffer-mark (copy-mark point))
     400      (push-new-buffer-mark point)
    401401      (insert-region point region)
    402402      (setf (last-command-type) :ephemerally-active))))

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

    r7898 r7913  
    313313           (point (current-point)))
    314314      (with-mark ((ipoint point :left-inserting))
    315         (let ((save-end2-loc (push-buffer-mark (copy-mark end2))))
     315        (let ((save-end2-loc (push-new-buffer-mark end2)))
    316316          (ninsert-region (move-mark ipoint end2) region1)
    317           (push-buffer-mark (copy-mark ipoint))
     317          (push-new-buffer-mark ipoint)
    318318          (cond (adjacent-p
    319                  (push-buffer-mark (copy-mark start2))
     319                 (push-new-buffer-mark start2)
    320320                 (move-mark point save-end2-loc))
    321                 (t (push-buffer-mark (copy-mark end1))
     321                (t (push-new-buffer-mark end1)
    322322                   (ninsert-region (move-mark ipoint end1) region2)
    323323                   (move-mark point ipoint))))))
    … …  
    400400             (declare (simple-string name))
    401401             (cond ((not againp)
    402                     (push-buffer-mark (copy-mark point)))
     402                    (push-new-buffer-mark point))
    403403                   ((string-equal name *goto-page-last-string*)
    404404                    (setf dir (nthcdr *goto-page-last-num* dir))

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

    r7911 r7913  
    7171   #:pop-buffer-mark
    7272   #:push-buffer-mark
     73   #:push-new-buffer-mark
    7374   #:change-to-buffer
    7475   #:make-buffer

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

    r7833 r7913  
    179179      (editor-error "Register ~A does not hold a region." reg-name))
    180180    (let ((point (current-point)))
    181       (push-buffer-mark (copy-mark point))
    182       (insert-region (current-point) (car val))))
     181      (push-new-buffer-mark point)
     182      (insert-region point (car val))))
    183183  (setf (last-command-type) :ephemerally-active))
Note: See TracChangeset for help on using the changeset viewer.