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