Update of /project/gsharp/cvsroot/gsharp
In directory clnet:/tmp/cvs-serv10976
Modified Files:
gui.lisp
Log Message:
Define a method on esa-current-buffer, not frame-current-buffer, after
Troels' reworking.
Also rewrite BUFFERS method so that if the window doesn't yet have a
view nothing bad happens.
This allows writing gsharp:gsharp and gsharp:edit-file in terms of
executing commands on an (adopted) gsharp frame, reducing code
duplication and also fixing a bad bug in gsharp:edit-file, which would
destroy the layer/staff structure if the file's first layer spanned
multiple staves.
--- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/10/27 02:10:55 1.88
+++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/11/21 19:22:03 1.89
@@ -73,6 +73,7 @@
standard-application-frame)
((views :initarg :views :initform '() :accessor views)
(input-state :initarg :input-state :accessor input-state))
+ (:default-initargs :input-state (make-input-state))
(:menu-bar menubar-command-table :height 25)
(:pointer-documentation t)
(:panes
@@ -118,11 +119,13 @@
(:top-level (esa-top-level)))
(defmethod buffers ((application-frame gsharp))
- (remove-duplicates (mapcar (lambda (window) (buffer (view window)))
- (windows application-frame))
- :test #'eq))
+ (let (result)
+ (dolist (window (windows application-frame) (nreverse result))
+ (let ((view (view window)))
+ (when view
+ (pushnew (buffer view) result))))))
-(defmethod frame-current-buffer ((application-frame gsharp))
+(defmethod esa-current-buffer ((application-frame gsharp))
(buffer (view (car (windows application-frame)))))
(defun current-cursor ()
@@ -548,39 +551,28 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
-;;; main entry point
+;;; main entry points
-(defun gsharp-common (buffer new-process process-name width height)
- (let* ((staff (car (staves buffer)))
- (input-state (make-input-state))
- (cursor (make-initial-cursor buffer))
- (view (make-instance 'orchestra-view
- :buffer buffer
- :cursor cursor)))
- (let ((frame (make-application-frame 'gsharp
- :buffer buffer
- :input-state input-state
- :cursor cursor
- :width width :height height)))
- (push view (views frame))
- (flet ((run ()
- (run-frame-top-level frame)))
- (setf (staves (car (layers (car (segments buffer))))) (list staff))
- (if new-process
- (clim-sys:make-process #'run :name process-name)
- (run))))))
-
-(defun gsharp (&key new-process (process-name "Gsharp")
- (width 900) (height 600))
+(defun gsharp (&rest args &key new-process process-name width height)
"Start a Gsharp session with a fresh empty buffer"
- (gsharp-common (make-instance 'buffer)
- new-process process-name width height))
+ (declare (ignore new-process process-name width height))
+ (apply #'gsharp-common '(com-new-buffer) args))
-(defun edit-file (filename &key new-process (process-name "Gsharp")
- (width 900) (height 600))
+(defun edit-file (filename &rest args
+ &key new-process process-name width height)
"Start a Gsharp session editing a given file"
- (gsharp-common (read-everything filename)
- new-process process-name width height))
+ (declare (ignore new-process process-name width height))
+ (apply #'gsharp-common `(esa-io::com-find-file ,filename) args))
+
+(defun gsharp-common (command &key new-process (process-name "Gsharp") width height)
+ (let ((*application-frame*
+ (make-application-frame 'gsharp :width width :height height)))
+ (adopt-frame (find-frame-manager) *application-frame*)
+ (execute-frame-command *application-frame* command)
+ (flet ((run () (run-frame-top-level *application-frame*)))
+ (if new-process
+ (clim-sys:make-process #'run :name process-name)
+ (run)))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;
