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) #\[))
