Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/buffer.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/buffer.lisp (revision 7912) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/buffer.lisp (revision 7913) @@ -331,5 +331,5 @@ ;; establish a new (empty) region at point. (unless (%buffer-current-region-p b) - (push-buffer-mark (copy-mark point) t)) + (push-new-buffer-mark point t)) point)) Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/command.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/command.lisp (revision 7912) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/command.lisp (revision 7913) @@ -307,5 +307,5 @@ "Sets the current region from point to the end of the buffer." (declare (ignore p)) - (push-buffer-mark (buffer-end (copy-mark (current-point))) t)) + (buffer-end (push-new-buffer-mark (current-point) t))) (defcommand "Mark to Beginning of Buffer" (p) @@ -313,5 +313,5 @@ "Sets the current region from the beginning of the buffer to point." (declare (ignore p)) - (push-buffer-mark (buffer-start (copy-mark (current-point))) t)) + (buffer-start (push-new-buffer-mark (current-point) t))) (defcommand "Beginning of Buffer" (p) @@ -320,5 +320,5 @@ (declare (ignore p)) (let ((point (current-point-collapsing-selection))) - (push-buffer-mark (copy-mark point)) + (push-new-buffer-mark point) (buffer-start point))) @@ -328,5 +328,5 @@ (declare (ignore p)) (let ((point (current-point-collapsing-selection))) - (push-buffer-mark (copy-mark point)) + (push-new-buffer-mark point) (buffer-end point))) Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/edit-defs.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/edit-defs.lisp (revision 7912) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/edit-defs.lisp (revision 7913) @@ -151,5 +151,5 @@ (string-upcase name) *last-go-to-def-string*))) (if (eq buffer (current-buffer)) - (push-buffer-mark (copy-mark point))) + (push-new-buffer-mark point)) (move-mark point def-mark)))) (t @@ -161,5 +161,5 @@ (string-upcase name) *last-go-to-def-string*)) (let ((point (current-point))) - (push-buffer-mark (copy-mark point)) + (push-new-buffer-mark point) (move-mark point m)))))))) |# Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/filecoms.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/filecoms.lisp (revision 7912) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/filecoms.lisp (revision 7913) @@ -278,5 +278,5 @@ (region (region start end))) (setv pathname-defaults pn) - (push-buffer-mark (copy-mark end)) + (push-new-buffer-mark end) (read-file pn end) (make-region-undo :delete "Insert File" region))) Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/isearchcoms.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/isearchcoms.lisp (revision 7912) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/isearchcoms.lisp (revision 7913) @@ -133,5 +133,5 @@ (let* ((iss (make-isearch-state :direction direction :start-region (current-region-info)))) - (push-buffer-mark (copy-mark (current-point))) + (push-new-buffer-mark (current-point)) (setf (value i-search-state) iss) (%i-search-message iss))) Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/killcoms.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/killcoms.lisp (revision 7912) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/killcoms.lisp (revision 7913) @@ -145,4 +145,7 @@ (%buffer-push-buffer-mark (current-buffer) mark activate-region)) +(defun push-new-buffer-mark (mark &optional (activate-region nil)) + "Pushes a new mark at argument position" + (push-buffer-mark (copy-mark mark :right-inserting) activate-region)) (defcommand "Set/Pop Mark" (p) @@ -154,5 +157,5 @@ "Set or Pop the mark ring." (cond ((not p) - (push-buffer-mark (copy-mark (current-point)) t) + (push-new-buffer-mark (current-point) t) (message "Mark pushed.")) ((= p (value universal-argument-default)) @@ -197,8 +200,8 @@ (end (region-end region)) (point (current-point))) - (push-buffer-mark (copy-mark point)) - (cond (p (push-buffer-mark (copy-mark start) t) + (push-new-buffer-mark point) + (cond (p (push-new-buffer-mark start t) (move-mark point end)) - (t (push-buffer-mark (copy-mark end) t) + (t (push-new-buffer-mark end t) (move-mark point start))))) @@ -474,6 +477,5 @@ (let* ((region (ring-ref *kill-ring* idx)) (point (current-point-for-insertion)) - (mark (copy-mark point))) - (push-buffer-mark mark) + (mark (push-new-buffer-mark point))) (insert-region point region) (make-region-undo :delete "Un-Kill" Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/lispmode.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/lispmode.lisp (revision 7912) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/lispmode.lisp (revision 7913) @@ -1411,5 +1411,5 @@ (pre-command-parse-check m) (let ((count (or p 1)) - (mark (push-buffer-mark (copy-mark m) t))) + (mark (push-new-buffer-mark m t))) (if (form-offset m count) (move-mark mark m) @@ -1430,5 +1430,5 @@ (t (move-mark point start) - (move-mark (push-buffer-mark (copy-mark point) t) end)))))) + (move-mark (push-new-buffer-mark point t) end)))))) (defcommand "Forward Kill Form" (p) Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/listener.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/listener.lisp (revision 7912) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/listener.lisp (revision 7913) @@ -398,5 +398,5 @@ (region (copy-mark start) (copy-mark end)))))) (buffer-end point) - (push-buffer-mark (copy-mark point)) + (push-new-buffer-mark point) (insert-region point region) (setf (last-command-type) :ephemerally-active)))) Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/morecoms.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/morecoms.lisp (revision 7912) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/morecoms.lisp (revision 7913) @@ -313,11 +313,11 @@ (point (current-point))) (with-mark ((ipoint point :left-inserting)) - (let ((save-end2-loc (push-buffer-mark (copy-mark end2)))) + (let ((save-end2-loc (push-new-buffer-mark end2))) (ninsert-region (move-mark ipoint end2) region1) - (push-buffer-mark (copy-mark ipoint)) + (push-new-buffer-mark ipoint) (cond (adjacent-p - (push-buffer-mark (copy-mark start2)) + (push-new-buffer-mark start2) (move-mark point save-end2-loc)) - (t (push-buffer-mark (copy-mark end1)) + (t (push-new-buffer-mark end1) (ninsert-region (move-mark ipoint end1) region2) (move-mark point ipoint)))))) @@ -400,5 +400,5 @@ (declare (simple-string name)) (cond ((not againp) - (push-buffer-mark (copy-mark point))) + (push-new-buffer-mark point)) ((string-equal name *goto-page-last-string*) (setf dir (nthcdr *goto-page-last-num* dir)) Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/package.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/package.lisp (revision 7912) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/package.lisp (revision 7913) @@ -71,4 +71,5 @@ #:pop-buffer-mark #:push-buffer-mark + #:push-new-buffer-mark #:change-to-buffer #:make-buffer Index: /branches/event-ide/ccl/cocoa-ide/hemlock/src/register.lisp =================================================================== --- /branches/event-ide/ccl/cocoa-ide/hemlock/src/register.lisp (revision 7912) +++ /branches/event-ide/ccl/cocoa-ide/hemlock/src/register.lisp (revision 7913) @@ -179,5 +179,5 @@ (editor-error "Register ~A does not hold a region." reg-name)) (let ((point (current-point))) - (push-buffer-mark (copy-mark point)) - (insert-region (current-point) (car val)))) + (push-new-buffer-mark point) + (insert-region point (car val)))) (setf (last-command-type) :ephemerally-active))