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

[Elliott Johnson]

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

Modified Files:
	gui.lisp kill-ring.lisp packages.lisp 
Log Message:
Tiding up a kill ring warning and move buffer related material to gui.lisp
Date: Wed Dec 29 08:06:46 2004
Author: ejohnson

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.28 climacs/gui.lisp:1.29
--- climacs/gui.lisp:1.28	Wed Dec 29 07:58:53 2004
+++ climacs/gui.lisp	Wed Dec 29 08:06:46 2004
@@ -345,6 +345,31 @@
 ;; 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)))
+
 (define-command com-copy-in ()
   (kr-copy-out (point (win *application-frame*)) *kill-ring*))
 
@@ -375,7 +400,6 @@
 (define-command com-kr-resize ()
   (let ((size (accept 'fixnum :prompt "New kill ring size: ")))
     (kr-resize *kill-ring* size)))
-
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 


Index: climacs/kill-ring.lisp
diff -u climacs/kill-ring.lisp:1.1 climacs/kill-ring.lisp:1.2
--- climacs/kill-ring.lisp:1.1	Wed Dec 29 06:45:37 2004
+++ climacs/kill-ring.lisp	Wed Dec 29 08:06:46 2004
@@ -39,23 +39,27 @@
 		 :max-size size
 		 :flexichain (make-instance 'standard-flexichain)))
 
-;; Didn't see a real reason to make gf's for these.
 
-(defun kr-length (kr)
-  "Returns the length of a kill-rings flexichain"
+(defgeneric kr-length (kr)
+  (:documentation "Returns the length of a kill-ring's flexichain"))
+
+(defmethod kr-length ((kr kill-ring))
   (nb-elements (kr-flexi kr)))
 
-(defun kr-resize (kr size)
-  "Resize a kill-ring to the value of size"
-  (kr-p kr)
+(defgeneric kr-resize (kr size)
+  (:documentation "Resize a kill ring to the value of SIZE"))
+
+(defmethod kr-resize ((kr kill-ring) size)
   (setf (slot-value kr 'max-size) size)
   (let ((len (kr-length kr)))
     (if (> len size)
 	(loop for n from 1 to (- len size)
 	      do (pop-end (kr-flexi kr))))))
 
-(defun kr-push (kr object)
-  "Push an object onto a kill-ring with size considerations"
+(defgeneric kr-push (kr object)
+  (:documentation "Push an object onto a kill ring with size considerations"))
+  
+(defmethod kr-push ((kr kill-ring) object)
   (let ((flexi (kr-flexi kr)))
     (if (>= (kr-length kr)(kr-max-size kr))
 	((lambda (flex obj)
@@ -64,37 +68,27 @@
 	 flexi object)
         (push-start flexi object))))
 
-(defun kr-pop (kr)
-  "Pops an object off of a kill-ring"
+(defgeneric kr-pop (kr)
+  (:documentation "Pops an object off of a kill ring"))
+
+(defmethod kr-pop ((kr kill-ring))
   (if (> (nb-elements (kr-flexi kr)) 0)
       (pop-start (kr-flexi kr))
       nil))
 
-(defun kr-rotate (kr &optional (n -1))
-  "Rotates the kill-ring either once forward or an optional amount +/-"
+(defgeneric kr-rotate (kr &optional n)
+  (:documentation "Rotates the kill ring either once forward or an optional amound +/-"))
+
+(defmethod kr-rotate ((kr kill-ring) &optional (n -1))
   (assert (typep n 'fixnum)(n) "Can not rotate the kill ring ~S positions" n)
   (let ((flexi (kr-flexi kr)))
     (rotate flexi n)))
 
-(defun kr-copy (kr)
-  "Copies out a member of a kill-ring without deleting it"
+(defgeneric kr-copy (kr)
+  (:documentation "Copies out a member of a kill ring without deleting it"))
+
+(defmethod kr-copy ((kr kill-ring))
   (let ((object (kr-pop kr)))
     (kr-push kr object)
     object))
 
-(defun kr-copy-in (buffer kr offset1 offset2)
-  "Non destructively copies in buffer region to the kill-ring"
-  (kr-push kr (buffer-sequence buffer offset1 offset2)))
-
-(defun kr-cut-in (buffer kr offset1 offset2)
-  "Destructively cuts a given buffer region into the kill-ring"
-  (kr-copy-in buffer kr offset1 offset2)
-  (climacs-buffer::delete-buffer-range buffer offset1 (- offset2 offset1))) 
-				       
-(defun kr-copy-out (mark kr)
-  "Copies an element from a kill-ring to a buffer at the given offset"
-  (insert-sequence mark (kr-copy kr)))
-
-(defun kr-cut-out (mark kr)
-  "Cuts an element from a kill-ring out to a buffer at a given offset"
-  (insert-sequence mark (kr-pop kr)))
\ No newline at end of file


Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.13 climacs/packages.lisp:1.14
--- climacs/packages.lisp:1.13	Wed Dec 29 07:58:53 2004
+++ climacs/packages.lisp	Wed Dec 29 08:06:46 2004
@@ -62,9 +62,9 @@
 
 (defpackage :climacs-kill-ring
   (:use :clim-lisp :climacs-buffer :flexichain)
-  (:export #:initialize-kill-ring #:kr-length #:kr-resize
-	   #:kr-rotate #:kr-copy-in #:kr-cut-in #:kr-copy-out 
-	   #:kr-cut-out))
+  (:export #:initialize-kill-ring #:kr-length
+	   #:kr-resize #:kr-rotate #:kill-ring
+	   #:kr-copy #:kr-push #:kr-pop))
 
 (defpackage :climacs-gui
   (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax :climacs-kill-ring))