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

[Robert Strandh]

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

Modified Files:
	gui.lisp packages.lisp 
Log Message:
Box ajuster gadget for changing size of windows
(thanks to Nicolas Lamirault)
[though I did not put this in yet, because it seems to break 
com-delete-window.  If someone can figure out why, I'll put it in.]

Kill-buffer command
(thanks to Lawrence Mitchell)


Date: Thu Jan 20 22:54:55 2005
Author: rstrandh

Index: climacs/gui.lisp
diff -u climacs/gui.lisp:1.90 climacs/gui.lisp:1.91
--- climacs/gui.lisp:1.90	Thu Jan 20 15:42:04 2005
+++ climacs/gui.lisp	Thu Jan 20 22:54:54 2005
@@ -681,6 +681,19 @@
     (beginning-of-buffer (point (current-window)))
     (full-redisplay (current-window))))
 
+(define-named-command com-kill-buffer ()
+  (with-slots (buffers) *application-frame*
+    (let ((buffer (buffer (current-window))))
+      (when (and (needs-saving buffer)
+		 (accept 'boolean :prompt "Save buffer first?"))
+        (com-save-buffer))
+      (setf buffers (remove buffer buffers))
+      ;; Always need one buffer.
+      (when (null buffers)
+	(push (make-instance 'climacs-buffer :name "*scratch*")
+	      buffers))
+      (setf (buffer (current-window)) (car buffers)))))
+
 (define-named-command com-full-redisplay ()
   (full-redisplay (current-window)))
 
@@ -769,6 +782,34 @@
 ;;; 
 ;;; Commands for splitting windows
 
+;;; put this in for real when we find a solution for the problem
+;;; it causes for com-delete-window 
+;; (defun replace-constellation (constellation additional-constellation vertical-p)
+;;   (let* ((parent (sheet-parent constellation))
+;; 	 (children (sheet-children parent))
+;; 	 (first (first children))
+;; 	 (second (second children))
+;;          (adjust (make-pane 'clim-extensions:box-adjuster-gadget)))
+;;     (assert (member constellation children))
+;;     (cond ((eq constellation first)
+;; 	   (sheet-disown-child parent constellation)
+;; 	   (let ((new (if vertical-p
+;; 			  (vertically ()
+;;                             constellation adjust additional-constellation)
+;; 			  (horizontally ()
+;;                             constellation adjust additional-constellation))))
+;; 	     (sheet-adopt-child parent new)
+;; 	     (reorder-sheets parent (list new second))))
+;; 	  (t
+;; 	   (sheet-disown-child parent constellation)
+;; 	   (let ((new (if vertical-p
+;; 			  (vertically ()
+;;                             constellation adjust additional-constellation)
+;; 			  (horizontally ()
+;;                             constellation adjust additional-constellation))))
+;; 	     (sheet-adopt-child parent new)
+;; 	     (reorder-sheets parent (list first new)))))))
+
 (defun replace-constellation (constellation additional-constellation vertical-p)
   (let* ((parent (sheet-parent constellation))
 	 (children (sheet-children parent))
@@ -1070,6 +1111,7 @@
 (c-x-set-key '(#\e) 'com-call-last-kbd-macro)
 (c-x-set-key '(#\c :control) 'com-quit)
 (c-x-set-key '(#\f :control) 'com-find-file)
+(c-x-set-key '(#\k) 'com-kill-buffer)
 (c-x-set-key '(#\l :control) 'com-load-file)
 (c-x-set-key '(#\o) 'com-other-window)
 (c-x-set-key '(#\s :control) 'com-save-buffer)


Index: climacs/packages.lisp
diff -u climacs/packages.lisp:1.36 climacs/packages.lisp:1.37
--- climacs/packages.lisp:1.36	Wed Jan 19 12:04:39 2005
+++ climacs/packages.lisp	Thu Jan 20 22:54:54 2005
@@ -102,5 +102,5 @@
 
 (defpackage :climacs-gui
   (:use :clim-lisp :clim :climacs-buffer :climacs-base :climacs-abbrev :climacs-syntax
-	:climacs-kill-ring :climacs-pane))
+	:climacs-kill-ring :climacs-pane :clim-extensions))