[gsharp-cvs] CVS gsharp

[crhodes]

Update of /project/gsharp/cvsroot/gsharp
In directory cl-net:/tmp/cvs-serv11043

Modified Files:
	gui.lisp modes.lisp 
Log Message:
Slightly rudimentary support for view/buffer handling (C-x b and C-x k)

The major thing that needs fixing is being currently unable to name and
refer to views with a sensible (unique) string name.


--- /project/gsharp/cvsroot/gsharp/gui.lisp	2009/04/20 15:04:47	1.97
+++ /project/gsharp/cvsroot/gsharp/gui.lisp	2009/05/17 16:11:57	1.98
@@ -25,6 +25,30 @@
   ((cursor :initarg :cursor :reader cursor)
    (buffer :initarg :buffer :reader buffer)))
 
+;;; FIXME: we need to sort out Drei's definition of accept methods for
+;;; the general VIEW type.
+;;;
+;;; FIXME: we should name our views so that they can be found by a
+;;; string name, rather than the unreadable-object print.  There's a
+;;; SUBSCRIPTABLE-NAME-MIXIN in ESA-UTILS that is used for this
+;;; purpose in the analogous place in Climacs.
+(define-presentation-method accept 
+    ((type orchestra-view) stream (view textual-view)
+     &key (default nil defaultp) (default-type type))
+  (multiple-value-bind (object success string)
+      (complete-input stream
+		      (lambda (so-far action)
+			(complete-from-possibilities
+			 so-far (views *esa-instance*) '()
+                         :action action
+			 :name-key #'princ-to-string
+			 :value-key #'identity))
+		      :partial-completers '(#\Space))
+    (cond
+      (success (values object type))
+      ((and defaultp (= (length string) 0)) (values default default-type))
+      (t (input-not-of-required-type string type)))))
+
 ;;; exists for the sole purpose of a :before method that updates the
 ;;; measures of each modified buffer.
 (defclass gsharp-pane-mixin () ())
@@ -302,6 +326,7 @@
          (view (make-instance 'orchestra-view 
                               :buffer buffer
                               :cursor cursor)))
+    (push view (views *application-frame*))
     (setf (view (car (windows *application-frame*))) view
           (input-state *application-frame*) input-state
           (filepath buffer) filepath)
@@ -1533,6 +1558,38 @@
 (defmethod frame-make-new-buffer ((frame gsharp) &key &allow-other-keys)
   (make-instance 'buffer))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; Buffer / View handling
+
+;;; FIXME: these utility functions should live elsewhere.
+(defun current-view ()
+  (view (current-window)))
+
+(defun not-current-view ()
+  (find (current-view) (views *application-frame*) :test (complement #'eq)))
+
+(defun not-current-view-or-first ()
+  (or (not-current-view) (car (views *application-frame*))))
+
+(defun next-or-new-buffer-view ()
+  (or (not-current-view)
+      (progn (com-new-buffer) 
+	     (car (views *application-frame*)))))
+
+(define-gsharp-command (com-switch-to-view :name t)
+    ((view 'orchestra-view :default (not-current-view-or-first)))
+  (setf (view (current-window)) view))
+
+(define-gsharp-command (com-kill-view :name t)
+    ((view 'orchestra-view :default (current-view)))
+  (let ((views (views *application-frame*)))
+    (setf (views *application-frame*) (remove view views))
+    (when (eq view (current-view))
+      (let ((next-view (next-or-new-buffer-view)))
+	(setf (view (current-window)) next-view)))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Printing
--- /project/gsharp/cvsroot/gsharp/modes.lisp	2008/04/29 07:54:24	1.29
+++ /project/gsharp/cvsroot/gsharp/modes.lisp	2009/05/17 16:11:57	1.30
@@ -11,6 +11,9 @@
 (set-key `(com-delete-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\Rubout)))
 (set-key `(com-erase-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\Backspace)))
 
+(set-key `(com-switch-to-view ,*unsupplied-argument-marker*) 'global-gsharp-table '((#\x :control) #\b))
+(set-key `(com-kill-view ,*unsupplied-argument-marker*) 'global-gsharp-table '((#\x :control) #\k))
+
 ;;; FIXME: implement numeric arg handling
 (set-key 'com-forward-page 'global-gsharp-table '((#\x :control) #\]))
 (set-key 'com-backward-page 'global-gsharp-table '((#\x :control) #\[))