[climacs-cvs] CVS update: climacs/gui.lisp climacs/packages.lisp
Robert Strandh
rstrandh at common-lisp.net
Fri Jan 21 06:54:58 UTC 2005
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))
More information about the Climacs-cvs
mailing list