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

[Elliott Johnson]

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

Modified Files:
	gui.lisp kill-ring.lisp 
Log Message:
Kill Ring clean up.  Fixed com-cut-out bug and substituted my habitual use of lambdas for progn's
Date: Fri Jan  7 19:58:08 2005
Author: ejohnson

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.53 climacs/gui.lisp:1.54
--- climacs/gui.lisp:1.53	Fri Jan  7 16:01:20 2005
+++ climacs/gui.lisp	Fri Jan  7 19:58:08 2005
@@ -347,22 +347,22 @@
   (open-line (point (win *application-frame*))))
 
 (define-named-command com-kill-line ()
-  (let* ((payne (win *application-frame*))
-	 (pnt (point payne))
-         (mrk (offset pnt)))
-    (if (end-of-line-p pnt)
-	(forward-object pnt)
+  (let* ((pane (win *application-frame*))
+	 (point (point pane))
+         (mark (offset point)))
+    (if (end-of-line-p point)
+	(forward-object point)
 	(progn
-	  (end-of-line pnt)
-	  (cond ((or (beginning-of-buffer-p pnt)
-		     (end-of-buffer-p pnt)) nil)
-		((beginning-of-line-p pnt)(forward-object pnt)))))
-    (if (eq (previous-command payne) 'com-kill-line)
+	  (end-of-line point)
+	  (cond ((or (beginning-of-buffer-p point)
+		     (end-of-buffer-p point)) nil)
+		((beginning-of-line-p point)(forward-object point)))))
+    (if (eq (previous-command pane) 'com-kill-line)
 	(kill-ring-concatenating-push *kill-ring*
-				      (region-to-sequence mrk pnt))
+				      (region-to-sequence mark point))
         (kill-ring-standard-push *kill-ring*
-			       (region-to-sequence mrk pnt)))
-    (delete-region mrk pnt)))
+			       (region-to-sequence mark point)))
+    (delete-region mark point)))
 
 (define-named-command com-forward-word ()
   (forward-word (point (win *application-frame*))))
@@ -573,40 +573,35 @@
 ;; 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 ((offp (offset point))
-	   (offm (offset mark)))
-       (if (< offp offm)
-	   ((lambda (b o1 o2)
-	      (kill-ring-standard-push *kill-ring* (buffer-sequence b o1 o2))
-	      (delete-buffer-range b o1 (- o2 o1)))
-	    buffer offp offm)
-           ((lambda (b o1 o2)
-	      (kill-ring-standard-push *kill-ring* (buffer-sequence b o2 o1))
-	      (delete-buffer-range b o1 (- o2 o1)))
-	    buffer offm offp)))))
+     (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)))))))
 	     
 
 ;; Non destructively copies in buffer region to the kill ring
 (define-named-command com-copy-out ()
-  (with-slots (buffer point mark)(win *application-frame*)
-     (let ((off1 (offset point))
-	   (off2 (offset mark)))
-       (if (< off1 off2)
-	   (kill-ring-standard-push *kill-ring* (buffer-sequence buffer off1 off2))
-	   (kill-ring-standard-push *kill-ring* (buffer-sequence buffer off2 off1))))))
+  (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)))))
 
 
 (define-named-command com-rotate-yank ()
-  (let* ((payne (win *application-frame*))
-	 (pnt (point payne))
+  (let* ((pane (win *application-frame*))
+	 (point (point pane))
 	 (last-yank (kill-ring-yank *kill-ring*)))
-    (if (eq (previous-command payne)
+    (if (eq (previous-command pane)
 	    'com-rotate-yank)
-	((lambda (p ly)
-	   (delete-range p (* -1 (length ly)))
-	   (rotate-yank-position *kill-ring*))
-	 pnt last-yank))
-    (insert-sequence pnt (kill-ring-yank *kill-ring*))))
+	(progn
+	  (delete-range point (* -1 (length last-yank)))
+	  (rotate-yank-position *kill-ring*)))
+    (insert-sequence point (kill-ring-yank *kill-ring*))))
 
 (define-named-command com-resize-kill-ring ()
   (let ((size (accept 'integer :prompt "New kill ring size")))


Index: climacs/kill-ring.lisp
diff -u climacs/kill-ring.lisp:1.4 climacs/kill-ring.lisp:1.5
--- climacs/kill-ring.lisp:1.4	Fri Jan  7 14:07:45 2005
+++ climacs/kill-ring.lisp	Fri Jan  7 19:58:08 2005
@@ -113,10 +113,9 @@
   (let ((chain (kill-ring-chain kr)))
     (if (>= (kill-ring-length kr)
 	    (kill-ring-max-size kr))
-	((lambda (flex obj)
-	   (pop-end flex)
-	   (push-start flex obj))
-	 chain vector)
+	(progn
+	  (pop-end chain)
+	  (push-start chain vector))
         (push-start chain vector)))
   (reset-yank-position kr))
 
@@ -132,5 +131,4 @@
 
 (defmethod kill-ring-yank ((kr kill-ring) &optional (reset NIL))
   (if reset (reset-yank-position kr))
-  (element> (kill-ring-cursor kr)))
-
+  (element> (kill-ring-cursor kr)))
\ No newline at end of file