Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv4907
Modified Files: gui.lisp Log Message: Minor clean ups on com-cut-out and com-copy-out. Basically leftover bits of code that could be factored out. Date: Sat Jan 8 07:30:28 2005 Author: ejohnson
Index: climacs/gui.lisp diff -u climacs/gui.lisp:1.54 climacs/gui.lisp:1.55 --- climacs/gui.lisp:1.54 Fri Jan 7 19:58:08 2005 +++ climacs/gui.lisp Sat Jan 8 07:30:25 2005 @@ -572,24 +572,18 @@
;; Destructively cut a given buffer region into the kill-ring (define-named-command com-cut-out () - (with-slots (buffer point mark)(win *application-frame*) - (let ((offset-point (offset point)) - (offset-mark (offset mark))) - (if (< offset-point offset-mark) - (progn - (kill-ring-standard-push *kill-ring* (region-to-sequence point mark)) - (delete-buffer-range buffer offset-point (- offset-mark offset-point ))) - (progn - (kill-ring-standard-push *kill-ring* (region-to-sequence mark point)) - (delete-buffer-range buffer offset-mark (- offset-point offset-mark))))))) - + (with-slots (point mark)(win *application-frame*) + (cond ((< (offset mark)(offset point)) + (kill-ring-standard-push *kill-ring* (region-to-sequence mark point)) + (delete-region (offset mark) point)) + (t + (kill-ring-standard-push *kill-ring* (region-to-sequence point mark)) + (delete-region (offset point) mark)))))
;; Non destructively copies in buffer region to the kill ring (define-named-command com-copy-out () (with-slots (point mark)(win *application-frame*) - (if (< (offset point) (offset mark)) - (kill-ring-standard-push *kill-ring* (region-to-sequence point mark)) - (kill-ring-standard-push *kill-ring* (region-to-sequence mark point))))) + (kill-ring-standard-push *kill-ring* (region-to-sequence point mark))))
(define-named-command com-rotate-yank ()