[climacs-cvs] CVS update: climacs/gui.lisp

Elliott Johnson ejohnson at common-lisp.net
Sat Jan 8 06:30:29 UTC 2005


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 ()




More information about the Climacs-cvs mailing list