From crhodes at common-lisp.net Wed Nov 21 19:22:03 2007 From: crhodes at common-lisp.net (crhodes) Date: Wed, 21 Nov 2007 14:22:03 -0500 (EST) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20071121192203.30D725F01A@common-lisp.net> 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))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; From crhodes at common-lisp.net Thu Nov 22 09:33:03 2007 From: crhodes at common-lisp.net (crhodes) Date: Thu, 22 Nov 2007 04:33:03 -0500 (EST) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20071122093303.9D793111CF@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv25528 Modified Files: gui.lisp Log Message: Make the Print Buffer To File command output eps if the pathname type is "eps". No error-checking for multiple pages or anything sensible like that. --- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/11/21 19:22:03 1.89 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/11/22 09:33:03 1.90 @@ -1530,17 +1530,19 @@ :default (print-buffer-filename) :default-type 'pathname :insert-default t)) (with-open-file (ps filepath :direction :output :if-exists :supersede) - (with-output-to-postscript-stream (s ps) - (setf (stream-default-view s) - ;; FIXME: should probably get the class of the view from - ;; the current buffer or window or something. - (make-instance 'orchestra-view :light-glyphs-ink +black+ - :buffer (current-buffer) :cursor (current-cursor))) - (setf (medium-transformation s) - ;; FIXME: This scaling works for me (A4 paper, default - ;; gsharp buffer sizes. - (compose-scaling-with-transformation (medium-transformation s) - 0.8 0.8)) - (print-buffer s (current-buffer) (current-cursor) - (left-margin (current-buffer)) 100)))) - + (let* ((type (pathname-type filepath)) + (epsp (string-equal type "EPS"))) + (with-output-to-postscript-stream (s ps :device-type (when epsp :eps)) + (setf (stream-default-view s) + ;; FIXME: should probably get the class of the view from + ;; the current buffer or window or something. + (make-instance 'orchestra-view :light-glyphs-ink +black+ + :buffer (current-buffer) + :cursor (current-cursor))) + (setf (medium-transformation s) + ;; FIXME: This scaling works for me (A4 paper, default + ;; gsharp buffer sizes. + (compose-scaling-with-transformation + (medium-transformation s) 0.8 0.8)) + (print-buffer s (current-buffer) (current-cursor) + (left-margin (current-buffer)) 100))))) From crhodes at common-lisp.net Sun Nov 25 14:19:29 2007 From: crhodes at common-lisp.net (crhodes) Date: Sun, 25 Nov 2007 09:19:29 -0500 (EST) Subject: [gsharp-cvs] CVS gsharp Message-ID: <20071125141929.BB2FB1B017@common-lisp.net> Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv1767 Modified Files: gui.lisp Log Message: Fix gsharp-common :new-process t We need a lexical variable to use inside RUN, which may be called inside a new thread. (Also, we might need to have bound *ESA-INSTANCE*, so let's do that proactively.) --- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/11/22 09:33:03 1.90 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/11/25 14:19:29 1.91 @@ -565,11 +565,12 @@ (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))) + (let* ((frame (make-application-frame 'gsharp :width width :height height)) + (*application-frame* frame) + (*esa-instance* frame)) (adopt-frame (find-frame-manager) *application-frame*) (execute-frame-command *application-frame* command) - (flet ((run () (run-frame-top-level *application-frame*))) + (flet ((run () (run-frame-top-level frame))) (if new-process (clim-sys:make-process #'run :name process-name) (run)))))