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

[Elliott Johnson]

Update of /project/climacs/cvsroot/climacs
In directory common-lisp.net:/tmp/cvs-serv22317

Modified Files:
	gui.lisp 
Log Message:
factored out kr generic functions in gui.lisp for define-commands
Date: Wed Dec 29 09:02:45 2004
Author: ejohnson

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.30 climacs/gui.lisp:1.31
--- climacs/gui.lisp:1.30	Wed Dec 29 08:26:02 2004
+++ climacs/gui.lisp	Wed Dec 29 09:02:45 2004
@@ -349,56 +349,36 @@
 ;;;;;;;;;;;;;;;;;;;;
 ;; Kill ring commands
 
-;; The naming may sound odd here, but think of electronic wireing:
-;; outputs to inputs and inputs to outputs.  Copying into a buffer 
-;; first requires coping out of the kill ring.
-
-(defgeneric kr-copy-in (buffer kr offset1 offset2)
-  (:documentation "Non destructively copies in buffer region to the kill ring"))
-
-(defmethod kr-copy-in ((buffer standard-buffer) (kr kill-ring) offset1 offset2)
-  (kr-push kr (buffer-sequence buffer offset1 offset2)))
- 
-(defgeneric kr-cut-in (buffer kr offset1 offset2)
-  (:documentation "Destructively cut a given buffer region into the kill-ring"))
-
-(defmethod kr-cut-in ((buffer standard-buffer) (kr kill-ring) offset1 offset2)  
-  (kr-copy-in buffer kr offset1 offset2)
-  (climacs-buffer::delete-buffer-range buffer offset1 (- offset2 offset1))) 
-
-(defgeneric kr-copy-out (mark kr)
-  (:documentation "Copies an element from a kill-ring to a buffer at the given offset"))
-
-(defmethod kr-copy-out ((mark standard-right-sticky-mark)(kr kill-ring))
-  (insert-sequence mark (kr-copy kr)))
-
-(defgeneric kr-cut-out (mark kr)
-  (:documentation "Cuts an element from a kill-ring out to a buffer at a given offset"))
-
-(defmethod kr-cut-out ((mark standard-right-sticky-mark) (kr kill-ring))
-  (insert-sequence mark (kr-pop kr)))
-
+;; Copies an element from a kill-ring to a buffer at the given offset
 (define-command com-copy-in ()
-  (kr-copy-out (point (win *application-frame*)) *kill-ring*))
+  (insert-sequence (point (win *application-frame*)) (kr-copy *kill-ring*)))
 
+;; Cuts an element from a kill-ring out to a buffer at a given offset
 (define-command com-cut-in ()
-  (kr-cut-out (point (win *application-frame*)) *kill-ring*))
+  (insert-sequence (point (win *application-frame*)) (kr-pop *kill-ring*)))
 
+;; Destructively cut a given buffer region into the kill-ring
 (define-command com-cut-out ()
   (with-slots (buffer point mark)(win *application-frame*)
-     (let ((off1 (offset point))
-	   (off2 (offset mark)))
-       (if (< off1 off2)
-	   (kr-cut-in buffer *kill-ring* off1 off2)
-	   (kr-cut-in buffer *kill-ring* off2 off1)))))
+     (if (< (offset point) (offset mark))
+	 ((lambda (b o1 o2)
+	    (kr-push *kill-ring* (buffer-sequence b o1 o2))
+	    (delete-buffer-range b o1 (- o2 o1))) 
+	  buffer (offset point) (offset mark))
+         ((lambda (b o1 o2)
+	    (kr-push *kill-ring* (buffer-sequence b o2 o1))
+	    (delete-buffer-range b o1 (- o2 o1)))
+	  buffer (offset mark) (offset point)))))
+	     
 
+;; Non destructively copies in buffer region to the kill ring
 (define-command com-copy-out ()
   (with-slots (buffer point mark)(win *application-frame*)
      (let ((off1 (offset point))
 	   (off2 (offset mark)))
        (if (< off1 off2)
-	   (kr-copy-in buffer *kill-ring* off1 off2)
-	   (kr-copy-in buffer *kill-ring* off2 off1)))))
+	   (kr-push *kill-ring* (buffer-sequence buffer off1 off2))
+	   (kr-push *kill-ring* (buffer-sequence buffer off2 off1))))))
 
 ;; Needs adjustment to be like emacs M-y
 (define-command com-kr-rotate ()