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

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;