From crhodes at common-lisp.net  Sat Oct  1 09:37:33 2005
From: crhodes at common-lisp.net (Christophe Rhodes)
Date: Sat,  1 Oct 2005 11:37:33 +0200 (CEST)
Subject: [gsharp-cvs] CVS update: gsharp/esa.lisp 
Message-ID: <20051001093733.64928880E6@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv1751

Modified Files:
	esa.lisp 
Log Message:
Merge climacs' version of esa

Date: Sat Oct  1 11:37:32 2005
Author: crhodes

Index: gsharp/esa.lisp
diff -u gsharp/esa.lisp:1.4 gsharp/esa.lisp:1.5
--- gsharp/esa.lisp:1.4	Mon Aug  8 02:22:07 2005
+++ gsharp/esa.lisp	Sat Oct  1 11:37:32 2005
@@ -301,7 +301,7 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
-;;; comand table manipulation
+;;; command table manipulation
 
 (defun ensure-subtable (table gesture)
   (let* ((event (make-instance
@@ -319,15 +319,20 @@
     (command-menu-item-value
      (find-keystroke-item event table :errorp nil))))
     
-      
 (defun set-key (command table gestures)
-  (if (null (cdr gestures))
-      (add-command-to-command-table
-       command table :keystroke (car gestures) :errorp nil)
-      (set-key command
-	       (ensure-subtable table (car gestures))
-	       (cdr gestures))))
-  
+  (unless (consp command)
+    (setf command (list command)))
+  (let ((gesture (car gestures)))
+    (cond ((null (cdr gestures))
+	   (add-command-to-command-table
+	    command table :keystroke gesture :errorp nil)
+	   (when (and (listp gesture)
+		      (find :meta gesture))
+	     (set-key command table (list (list :escape) (remove :meta gesture)))))
+	  (t (set-key command
+		      (ensure-subtable table gesture)
+		      (cdr gestures))))))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
 ;;; standard key bindings 
@@ -357,6 +362,209 @@
 
 (set-key 'com-extended-command 'global-esa-table '((#\x :meta)))
 
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; 
+;;; Help
+
+(defun read-gestures-for-help (command-table)
+  (loop for gestures = (list (esa-read-gesture))
+	  then (nconc gestures (list (esa-read-gesture)))
+	for item = (find-gestures-with-inheritance gestures command-table)
+	unless item
+	  do (return (values nil gestures))
+	when (eq (command-menu-item-type item) :command)
+	  do (return (values (command-menu-item-value item)
+			     gestures))))
+
+(defun describe-key-briefly (pane)
+  (let ((command-table (command-table pane)))
+    (multiple-value-bind (command gestures)
+	(read-gestures-for-help command-table)
+      (when (consp command)
+	(setf command (car command)))
+      (display-message "~{~A ~}~:[is not bound~;runs the command ~:*~A~]"
+		       (mapcar #'gesture-name gestures)
+		       (or (command-line-name-for-command
+			    command command-table :errorp nil)
+			   command)))))
+
+(defgeneric gesture-name (gesture))
+
+(defmethod gesture-name ((char character))
+  (or (char-name char)
+      char))
+
+(defun translate-name-and-modifiers (key-name modifiers)
+  (with-output-to-string (s)
+      (loop for (modifier name) on (list
+					;(+alt-key+ "A-")
+					+hyper-key+ "H-"
+					+super-key+ "s-"
+					+meta-key+ "M-"
+					+control-key+ "C-")
+	      by #'cddr
+	    when (plusp (logand modifier modifiers))
+	      do (princ name s))
+      (princ (if (typep key-name 'character)
+		 (or (char-name key-name)
+		     key-name)
+		 key-name) s)))
+
+(defmethod gesture-name ((ev keyboard-event))
+  (let ((key-name (keyboard-event-key-name ev))
+	(modifiers (event-modifier-state ev)))
+    (translate-name-and-modifiers key-name modifiers)))
+
+(defmethod gesture-name ((gesture list))
+  (cond ((eq (car gesture) :keyboard)
+	 (translate-name-and-modifiers (second gesture) (third gesture)))
+	;; punt on this for now
+	(t nil)))
+
+(defun find-keystrokes-for-command (command command-table)
+  (let ((keystrokes '()))
+    (labels ((helper (command command-table prefix)
+	       (map-over-command-table-keystrokes
+		#'(lambda (menu-name keystroke item)
+		    (declare (ignore menu-name))
+		    (cond ((and (eq (command-menu-item-type item) :command)
+				(eq (car (command-menu-item-value item)) command))
+			   (push (cons keystroke prefix) keystrokes))
+			  ((eq (command-menu-item-type item) :menu)
+			   (helper command (command-menu-item-value item) (cons keystroke prefix)))
+			  (t nil)))
+		command-table)))
+      (helper command command-table nil)
+      keystrokes)))
+
+(defun find-keystrokes-for-command-with-inheritance (command start-table)
+  (let ((keystrokes '()))
+    (labels  ((helper (table)
+		(let ((keys (find-keystrokes-for-command command table)))
+		  (when keys (push keys keystrokes))
+		  (dolist (subtable (command-table-inherit-from
+				     (find-command-table table)))
+		    (helper subtable)))))
+      (helper start-table))
+    keystrokes))
+
+(defun find-all-keystrokes-and-commands (command-table)
+  (let ((results '()))
+    (labels ((helper (command-table prefix)
+	       (map-over-command-table-keystrokes
+		#'(lambda (menu-name keystroke item)
+		    (declare (ignore menu-name))
+		    (cond ((eq (command-menu-item-type item) :command) 
+			   (push (cons (cons keystroke prefix)
+				       (command-menu-item-value item))
+				 results))
+			  ((eq (command-menu-item-type item) :menu)
+			   (helper (command-menu-item-value item) (cons keystroke prefix)))
+			  (t nil)))
+		command-table)))
+      (helper command-table nil)
+      results)))
+
+(defun find-all-keystrokes-and-commands-with-inheritance (start-table)
+  (let ((results '()))
+    (labels  ((helper (table)
+		(let ((res (find-all-keystrokes-and-commands table)))
+		  (when res  (setf results (nconc res results)))
+		  (dolist (subtable (command-table-inherit-from
+				     (find-command-table table)))
+		    (helper subtable)))))
+      (helper start-table))
+    results))
+
+(defun sort-by-name (list)
+  (sort list #'string< :key (lambda (item) (symbol-name (second item)))))
+
+(defun sort-by-keystrokes (list)
+  (sort list (lambda (a b)
+	       (cond ((and (characterp a)
+			   (characterp b))
+		      (char< a b))
+		     ((characterp a)
+		      t)
+		     ((characterp b)
+		      nil)
+		     (t (string< (symbol-name a)
+				 (symbol-name b)))))
+	:key (lambda (item) (second (first (first item))))))
+
+(defun describe-bindings (stream command-table
+			  &optional (sort-function #'sort-by-name))
+  (formatting-table (stream)
+    (loop for (keys command)
+	  in (funcall sort-function
+		      (find-all-keystrokes-and-commands-with-inheritance
+			   command-table))
+	  do (formatting-row (stream) 
+	       (formatting-cell (stream :align-x :right)
+		 (with-text-style (stream '(:sans-serif nil nil))
+		   (format stream "~A"
+			   (or (command-line-name-for-command command
+							      command-table
+							      :errorp nil)
+			       command))))
+	       (formatting-cell (stream)
+		 (with-drawing-options (stream :ink +dark-blue+
+					       :text-style '(:fix nil nil))
+		   (format stream "~&~{~A~^ ~}"
+			   (mapcar #'gesture-name (reverse keys))))))
+	  count command into length
+	  finally (change-space-requirements stream
+			 :height (* length (stream-line-height stream)))
+		  (scroll-extent stream 0 0))))
+
+;;; help commands
+
+(define-command-table help-table)
+
+(define-command (com-describe-key-briefly :name t :command-table help-table) ()
+  (display-message "Describe key briefly:")
+  (redisplay-frame-panes *application-frame*)
+  (describe-key-briefly (car (windows *application-frame*))))
+
+(set-key 'com-describe-key-briefly 'help-table '((#\h :control) (#\c)))
+
+(define-command (com-where-is :name t :command-table help-table) ()
+  (let* ((command-table (command-table (car (windows *application-frame*))))
+	 (command
+	  (handler-case
+	      (accept
+	       `(command-name :command-table
+			      ,command-table)
+	       :prompt "Where is command")
+	    (error () (progn (beep)
+			     (display-message "No such command")
+			     (return-from com-where-is nil)))))
+	 (keystrokes (find-keystrokes-for-command-with-inheritance command command-table)))
+    (display-message "~A is ~:[not on any key~;~:*on ~{~A~^, ~}~]"
+		     (command-line-name-for-command command command-table)
+		     (mapcar (lambda (keys)
+			       (format nil "~{~A~^ ~}"
+				       (mapcar #'gesture-name (reverse keys))))
+			     (car keystrokes)))))
+
+(set-key 'com-where-is 'help-table '((#\h :control) (#\w)))
+
+(define-command (com-describe-bindings :name t :command-table help-table)
+    ((sort-by-keystrokes 'boolean :prompt "Sort by keystrokes?"))
+  (let* ((window (car (windows *application-frame*))) 
+	 (stream (open-window-stream
+		  :label (format nil "Help: Describe Bindings")
+		  :input-buffer (climi::frame-event-queue *application-frame*)
+		  :width 400))
+	 (command-table (command-table window)))
+    (describe-bindings stream command-table
+		       (if sort-by-keystrokes
+			   #'sort-by-keystrokes
+			   #'sort-by-name))))
+
+(set-key `(com-describe-bindings ,*numeric-argument-p*) 'help-table '((#\h :control) (#\b)))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;; 
 ;;; Keyboard macros
@@ -420,7 +628,7 @@
 				   esa-frame-mixin)
   ()
   (:panes
-   (win (let* ((my-pane 
+   (window (let* ((my-pane 
 		(make-pane 'example-pane
 			   :width 900 :height 400
 			   :display-function 'display-my-pane
@@ -434,12 +642,12 @@
 	    (scrolling ()
 	      my-pane)
 	    my-info-pane)))
-   (int (make-pane 'example-minibuffer-pane :width 900)))
+   (minibuffer (make-pane 'example-minibuffer-pane :width 900)))
   (:layouts
    (default
        (vertically (:scroll-bars nil)
-	 win
-	 int)))
+	 window
+	 minibuffer)))
   (:top-level (esa-top-level)))
 
 (defun display-my-pane (frame pane)



From crhodes at common-lisp.net  Thu Oct 13 09:05:06 2005
From: crhodes at common-lisp.net (Christophe Rhodes)
Date: Thu, 13 Oct 2005 11:05:06 +0200 (CEST)
Subject: [gsharp-cvs] CVS update: gsharp/packages.lisp 
Message-ID: <20051013090506.93E24880DB@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv16387

Modified Files:
	packages.lisp 
Log Message:
Really make gsharp and climacs coexist

Date: Thu Oct 13 11:05:04 2005
Author: crhodes

Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.10 gsharp/packages.lisp:1.11
--- gsharp/packages.lisp:1.10	Mon Jul 25 13:14:38 2005
+++ gsharp/packages.lisp	Thu Oct 13 11:05:04 2005
@@ -135,6 +135,7 @@
 	   #:*numeric-argument-p* #:*current-gesture*
 	   #:esa-top-level #:simple-command-loop
 	   #:global-esa-table #:keyboard-macro-table
+           #:help-table
 	   #:set-key))
 
 (defpackage :score-pane



From rstrandh at common-lisp.net  Thu Oct 27 01:28:09 2005
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Thu, 27 Oct 2005 03:28:09 +0200 (CEST)
Subject: [gsharp-cvs] CVS update: gsharp/gui.lisp gsharp/score-pane.lisp 
Message-ID: <20051027012809.412EB8857A@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv6209

Modified Files:
	gui.lisp score-pane.lisp 
Log Message:
Removed Gsharp-specific code for double buffering.  
Replaced it by general mechanism now available in McCLIM.
This should also fix the pixmap-focus bug, though I can't test that
because I never could reproduce the problem.


Date: Thu Oct 27 03:28:08 2005
Author: rstrandh

Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.23 gsharp/gui.lisp:1.24
--- gsharp/gui.lisp:1.23	Mon Aug  8 01:18:02 2005
+++ gsharp/gui.lisp	Thu Oct 27 03:28:08 2005
@@ -26,7 +26,8 @@
    (score (let ((win (make-pane 'score-pane:score-pane
 				:width 400 :height 500
 				:name "score"
-				:display-time :no-clear
+				;; :incremental-redisplay t
+				:double-buffering t
 				:display-function 'display-score
 				:command-table 'total-melody-table)))
 	    (setf (windows *application-frame*) (list win))


Index: gsharp/score-pane.lisp
diff -u gsharp/score-pane.lisp:1.12 gsharp/score-pane.lisp:1.13
--- gsharp/score-pane.lisp:1.12	Mon Aug 15 23:45:01 2005
+++ gsharp/score-pane.lisp	Thu Oct 27 03:28:08 2005
@@ -608,20 +608,11 @@
     , at body))
 
 (defmacro with-score-pane (pane &body body)
-  (let ((pixmap (gensym))
-	(mirror (gensym)))
-    `(let* ((*pane* ,pane)
-	    (*lighter-gray-progressions* (lighter-gray-progressions pane))
-	    (*darker-gray-progressions* (darker-gray-progressions pane))
-	    (,pixmap (allocate-pixmap *pane* 800 900))
-	    (,mirror (sheet-direct-mirror *pane*)))
-      (draw-rectangle* ,pixmap 0 0 800 900 :filled t :ink +white+)
-      (setf (sheet-direct-mirror *pane*) (climi::pixmap-mirror ,pixmap))
-      (clear-output-record (stream-output-history *pane*))
-       , at body
-      (setf (sheet-direct-mirror *pane*) ,mirror)
-      (copy-from-pixmap ,pixmap 0 0 800 900 *pane* 0 0)
-      (deallocate-pixmap ,pixmap))))      
+  `(let* ((*pane* ,pane)
+	  (*lighter-gray-progressions* (lighter-gray-progressions pane))
+	  (*darker-gray-progressions* (darker-gray-progressions pane)))
+    (clear-output-record (stream-output-history *pane*))
+    , at body))
 
 (defmacro with-vertical-score-position ((pane yref) &body body)
   `(with-translation (,pane 0 ,yref)



From crhodes at common-lisp.net  Fri Oct 28 16:20:48 2005
From: crhodes at common-lisp.net (Christophe Rhodes)
Date: Fri, 28 Oct 2005 18:20:48 +0200 (CEST)
Subject: [gsharp-cvs] CVS update: gsharp/esa.lisp 
Message-ID: <20051028162048.892C28858F@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv11314

Modified Files:
	esa.lisp 
Log Message:
OK, no-one complained anywhere, so commit the rearrangement of esa's 
toplevel so that the window's command-table is reloaded every time, 
rather than just after abort gestures.  This makes it possible to change 
the active command table

Date: Fri Oct 28 18:20:47 2005
Author: crhodes

Index: gsharp/esa.lisp
diff -u gsharp/esa.lisp:1.5 gsharp/esa.lisp:1.6
--- gsharp/esa.lisp:1.5	Sat Oct  1 11:37:32 2005
+++ gsharp/esa.lisp	Fri Oct 28 18:20:47 2005
@@ -210,29 +210,32 @@
 (defun substitute-numeric-argument-p (command numargp)
   (substitute numargp *numeric-argument-p* command :test #'eq))
 
-(defun process-gestures (frame command-table)
-  (loop
-   for gestures = '()
-   do (multiple-value-bind (numarg numargp)
-	  (read-numeric-argument :stream *standard-input*)
-	(loop 
-	 (setf *current-gesture* (esa-read-gesture))
-	 (setf gestures 
-	       (nconc gestures (list *current-gesture*)))
-	 (let ((item (find-gestures-with-inheritance gestures command-table)))
-	   (cond 
-	     ((not item)
-	      (beep) (return))
-	     ((eq (command-menu-item-type item) :command)
-	      (let ((command (command-menu-item-value item)))
-		(unless (consp command)
-		  (setf command (list command)))
-		(setf command (substitute-numeric-argument-marker command numarg))
-		(setf command (substitute-numeric-argument-p command numargp))
-		(execute-frame-command frame command)
-		(return)))
-	     (t nil)))))
-   do (redisplay-frame-panes frame)))
+(defun process-gestures-or-command (frame command-table)
+  (with-input-context 
+      (`(command :command-table ,(command-table (car (windows frame)))))
+      (object)
+      (let ((gestures '()))
+        (multiple-value-bind (numarg numargp)
+            (read-numeric-argument :stream *standard-input*)
+          (loop 
+           (setf *current-gesture* (esa-read-gesture))
+           (setf gestures 
+                 (nconc gestures (list *current-gesture*)))
+           (let ((item (find-gestures-with-inheritance gestures command-table)))
+             (cond 
+               ((not item)
+                (beep) (return))
+               ((eq (command-menu-item-type item) :command)
+                (let ((command (command-menu-item-value item)))
+                  (unless (consp command)
+                    (setf command (list command)))
+                  (setf command (substitute-numeric-argument-marker command numarg))
+                  (setf command (substitute-numeric-argument-p command numargp))
+                  (execute-frame-command frame command)
+                  (return)))
+               (t nil))))))
+      (t
+       (execute-frame-command frame object))))
 
 (defmethod redisplay-frame-panes :around ((frame esa-frame-mixin) &key force-p)
   (declare (ignore force-p))
@@ -261,22 +264,13 @@
 	  (*abort-gestures* `((:keyboard #\g ,(make-modifier-state :control)))))
       (redisplay-frame-panes frame :force-p t)
       (loop
-       for maybe-error = t
        do (restart-case
-	   (progn
-	     (handler-case
-	      (with-input-context 
-		  (`(command :command-table ,(command-table (car (windows frame)))))
-		  (object)
-		  (process-gestures frame (command-table (car (windows frame))))
-		(t
-		 (execute-frame-command frame object)
-		 (setq maybe-error nil)))
-	      (abort-gesture () (display-message "Quit")))
-	     (when maybe-error
-	       (beep))
-	     (redisplay-frame-panes frame))
-	   (return-to-climacs () nil))))))
+              (progn
+                (handler-case
+                    (process-gestures-or-command frame (command-table (car (windows frame))))
+                  (abort-gesture () (display-message "Quit")))
+                (redisplay-frame-panes frame))
+	   (return-to-esa () nil))))))
 
 (defmacro simple-command-loop (command-table loop-condition end-clauses)
   (let ((gesture (gensym))



From crhodes at common-lisp.net  Fri Oct 28 16:22:02 2005
From: crhodes at common-lisp.net (Christophe Rhodes)
Date: Fri, 28 Oct 2005 18:22:02 +0200 (CEST)
Subject: [gsharp-cvs] CVS update: gsharp/gui.lisp 
Message-ID: <20051028162202.A0CD48858F@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv11353

Modified Files:
	gui.lisp 
Log Message:
Implement command table switching.  If we select a lyrics layer, then we 
want to be in lyrics mode -- activate the lyrics command table.

Date: Fri Oct 28 18:22:02 2005
Author: crhodes

Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.24 gsharp/gui.lisp:1.25
--- gsharp/gui.lisp:1.24	Thu Oct 27 03:28:08 2005
+++ gsharp/gui.lisp	Fri Oct 28 18:22:01 2005
@@ -13,7 +13,9 @@
       :height 20 :max-height 20 :min-height 20))
 
 (define-command-table total-melody-table
-    :inherit-from (melody-table global-gsharp-table))
+    :inherit-from (melody-table global-gsharp-table gsharp))
+(define-command-table total-lyrics-table
+    :inherit-from (lyrics-table global-gsharp-table gsharp))
 
 (define-application-frame gsharp (standard-application-frame
 				  esa-frame-mixin)
@@ -423,8 +425,11 @@
     (if success layer (error 'no-such-layer))))
 
 (defmethod select-layer :after (cursor (layer layer))
-  ;; set the command tables here
-  )
+  (typecase layer
+    (lyrics-layer (setf (command-table (first (windows *application-frame*)))
+                        (find-command-table 'total-lyrics-table)))
+    (melody-layer (setf (command-table (first (windows *application-frame*)))
+                        (find-command-table 'total-melody-table)))))
 
 (define-gsharp-command (com-select-layer :name t) ()
   (let ((selected-layer (accept 'layer :prompt "Select layer")))



From crhodes at common-lisp.net  Fri Oct 28 17:19:51 2005
From: crhodes at common-lisp.net (Christophe Rhodes)
Date: Fri, 28 Oct 2005 19:19:51 +0200 (CEST)
Subject: [gsharp-cvs] CVS update: gsharp/score-pane.lisp 
Message-ID: <20051028171951.62EE688576@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv15523

Modified Files:
	score-pane.lisp 
Log Message:
Remove input focusing code which, at a guess, was a workaround for 
long-since changed mcclim behaviour.  Now no longer annoyingly steals 
focus from other applications on the same virtual desktop.

Date: Fri Oct 28 19:19:50 2005
Author: crhodes

Index: gsharp/score-pane.lisp
diff -u gsharp/score-pane.lisp:1.13 gsharp/score-pane.lisp:1.14
--- gsharp/score-pane.lisp:1.13	Thu Oct 27 03:28:08 2005
+++ gsharp/score-pane.lisp	Fri Oct 28 19:19:50 2005
@@ -13,15 +13,6 @@
   (declare (ignore args))
   (setf (stream-default-view pane) (make-instance 'score-view)))
 
-(defmethod dispatch-event :before ((pane score-pane) (event pointer-enter-event))
-  (let ((port (port pane)))
-    (setf (port-keyboard-input-focus port) pane)))
-
-(defmethod dispatch-event :after ((pane score-pane) (event pointer-exit-event))
-  (let ((port (port pane)))
-    (setf (port-keyboard-input-focus port)
-	  (frame-standard-input (pane-frame pane)))))
-
 (defparameter *pane* nil)
 (defparameter *light-glyph* nil)
 (defparameter *font* nil)



From crhodes at common-lisp.net  Fri Oct 28 17:20:20 2005
From: crhodes at common-lisp.net (Christophe Rhodes)
Date: Fri, 28 Oct 2005 19:20:20 +0200 (CEST)
Subject: [gsharp-cvs] CVS update: gsharp/gui.lisp 
Message-ID: <20051028172020.3C6E388576@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv15560

Modified Files:
	gui.lisp 
Log Message:
Make the cursor be drawn in the right place.  Dunno why we need to 
negate y-offset.

Date: Fri Oct 28 19:20:19 2005
Author: crhodes

Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.25 gsharp/gui.lisp:1.26
--- gsharp/gui.lisp:1.25	Fri Oct 28 18:22:01 2005
+++ gsharp/gui.lisp	Fri Oct 28 19:20:19 2005
@@ -106,7 +106,8 @@
 (defun draw-the-cursor (pane x)
   (let* ((state (input-state *application-frame*))
 	 (staff (car (staves (layer (cursor *application-frame*)))))
-	 (yoffset (gsharp-drawing::staff-yoffset staff)))
+         ;; Why (- STAFF-YOFFSET)?  dunno.  -- CSR, 2005-10-28
+	 (yoffset (- (gsharp-drawing::staff-yoffset staff))))
     (if (typep staff 'fiveline-staff)
 	(let* ((clef (clef staff))
 	       (bottom-line (- (ecase (name clef) (:treble 32) (:bass 24) (:c 35))



From crhodes at common-lisp.net  Fri Oct 28 17:20:30 2005
From: crhodes at common-lisp.net (Christophe Rhodes)
Date: Fri, 28 Oct 2005 19:20:30 +0200 (CEST)
Subject: [gsharp-cvs] CVS update: gsharp/modes.lisp 
Message-ID: <20051028172030.CD74F88576@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv15575

Modified Files:
	modes.lisp 
Log Message:
Allow capital letters in lyrics.

Date: Fri Oct 28 19:20:30 2005
Author: crhodes

Index: gsharp/modes.lisp
diff -u gsharp/modes.lisp:1.6 gsharp/modes.lisp:1.7
--- gsharp/modes.lisp:1.6	Tue Aug  2 02:34:41 2005
+++ gsharp/modes.lisp	Fri Oct 28 19:20:30 2005
@@ -76,7 +76,7 @@
 (loop for c in '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M 
 		 #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)
       for i from 65
-      do (set-key (make-insert-fun i) 'lyrics-table `((,c :shift))))
+      do (set-key (make-insert-fun i) 'lyrics-table `((,c))))
 
 (loop for c in '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m 
 		 #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)



From rstrandh at common-lisp.net  Fri Oct 28 21:33:12 2005
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Fri, 28 Oct 2005 23:33:12 +0200 (CEST)
Subject: [gsharp-cvs] CVS update: gsharp/Flexichain/Doc/Makefile
	gsharp/Flexichain/Doc/tex-dependencies 
Message-ID: <20051028213312.AD2468859B@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp/Flexichain/Doc
In directory common-lisp.net:/tmp/cvs-serv1360/Doc

Modified Files:
	Makefile tex-dependencies 
Log Message:
Don't assume that `.' is in the PATH.

Date: Fri Oct 28 23:33:11 2005
Author: rstrandh

Index: gsharp/Flexichain/Doc/Makefile
diff -u gsharp/Flexichain/Doc/Makefile:1.1 gsharp/Flexichain/Doc/Makefile:1.2
--- gsharp/Flexichain/Doc/Makefile:1.1	Sun Aug  1 17:27:20 2004
+++ gsharp/Flexichain/Doc/Makefile	Fri Oct 28 23:33:11 2005
@@ -1,8 +1,8 @@
 NAME=flexichain
 
-TEXFILES=$(NAME).tex $(shell tex-dependencies $(NAME).tex)
-PSTEX_T=$(shell strip-dependence inputfig $(TEXFILES))
-VERBATIM=$(shell strip-dependence verbatimtabinput $(TEXFILES))
+TEXFILES=$(NAME).tex $(shell ./tex-dependencies $(NAME).tex)
+PSTEX_T=$(shell ./strip-dependence inputfig $(TEXFILES))
+VERBATIM=$(shell ./strip-dependence verbatimtabinput $(TEXFILES))
 PSTEX=$(subst .pstex_t,.pstex,$(PSTEX_T))
 
 all : $(NAME).ps


Index: gsharp/Flexichain/Doc/tex-dependencies
diff -u gsharp/Flexichain/Doc/tex-dependencies:1.1 gsharp/Flexichain/Doc/tex-dependencies:1.2
--- gsharp/Flexichain/Doc/tex-dependencies:1.1	Sun Aug  1 17:27:20 2004
+++ gsharp/Flexichain/Doc/tex-dependencies	Fri Oct 28 23:33:11 2005
@@ -1,10 +1,10 @@
 #!/bin/sh
 
 #set -x
-TEXFILES=$(strip-dependence inputtex $1)
+TEXFILES=$(./strip-dependence inputtex $1)
 echo -n $TEXFILES
 for i in $TEXFILES
 do
-    echo -n $(tex-dependencies $i)
+    echo -n $(./tex-dependencies $i)
 done
 echo



From crhodes at common-lisp.net  Fri Oct 28 22:16:38 2005
From: crhodes at common-lisp.net (Christophe Rhodes)
Date: Sat, 29 Oct 2005 00:16:38 +0200 (CEST)
Subject: [gsharp-cvs] CVS update: gsharp/esa.lisp 
Message-ID: <20051028221638.531BD8859A@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv4816

Modified Files:
	esa.lisp 
Log Message:
Sync with climacs.

Date: Sat Oct 29 00:16:37 2005
Author: crhodes

Index: gsharp/esa.lisp
diff -u gsharp/esa.lisp:1.6 gsharp/esa.lisp:1.7
--- gsharp/esa.lisp:1.6	Fri Oct 28 18:20:47 2005
+++ gsharp/esa.lisp	Sat Oct 29 00:16:37 2005
@@ -322,7 +322,16 @@
 	    command table :keystroke gesture :errorp nil)
 	   (when (and (listp gesture)
 		      (find :meta gesture))
-	     (set-key command table (list (list :escape) (remove :meta gesture)))))
+             ;; KLUDGE: this is a workaround for poor McCLIM
+             ;; behaviour; really this canonization should happen in
+             ;; McCLIM's input layer.
+	     (set-key command table
+		      (list (list :escape)
+			    (let ((esc-list (remove :meta gesture)))
+			      (if (and (= (length esc-list) 2)
+				       (find :shift esc-list))
+				  (remove :shift esc-list)
+				  esc-list))))))
 	  (t (set-key command
 		      (ensure-subtable table gesture)
 		      (cdr gestures))))))



From rstrandh at common-lisp.net  Mon Oct 31 01:39:25 2005
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Mon, 31 Oct 2005 02:39:25 +0100 (CET)
Subject: [gsharp-cvs] CVS update: gsharp/Doc/buffer.tex 
Message-ID: <20051031013925.C02FE88549@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp/Doc
In directory common-lisp.net:/tmp/cvs-serv27964

Modified Files:
	buffer.tex 
Log Message:
More documentation related to the buffer protocols.

Date: Mon Oct 31 02:39:24 2005
Author: rstrandh

Index: gsharp/Doc/buffer.tex
diff -u gsharp/Doc/buffer.tex:1.2 gsharp/Doc/buffer.tex:1.3
--- gsharp/Doc/buffer.tex:1.2	Mon Jul 19 08:23:53 2004
+++ gsharp/Doc/buffer.tex	Mon Oct 31 02:39:23 2005
@@ -87,7 +87,11 @@
 
 \Definitarg {:name}
 
-The default value for this initarg is \lispobj{"default"}. 
+This initarg indicates the name of the staff to be used.  The name of
+a staff must be unique and usually has some relationship to the
+instruments(s) displayed on it.  Examples of staff names would be
+``1st violin'', ``soprano & alto'', etc.  The default value for this
+initarg is \lispobj{"default staff"}.
 
 \Defgeneric {name} {staff}
 
@@ -96,14 +100,24 @@
 
 \Defclass {fiveline-staff}
 
+This class is a subclass of \texttt{staff} and is used to represent an
+ordinary five-line staff for displaying notes. 
+
 \Definitarg {:clef}
 
-This value must always be supplied. 
+This value must always be supplied, and must be an instance of the
+class \texttt{clef}.  The clef of a five-line staff indicates where
+on the staff notes are to be displayed.  
 
 \Definitarg {:keysig}
 
-The default value for this initarg is a vector with seven elements,
-each begin the object \lispobj{:natural}.
+This initarg is used to represent the key signature of the staff.  The
+value is a vector with seven elements, where each element corresponds
+to a note of the scale (C, D, E, F, G, A, B), and is a keyword
+(\texttt{:natural}, \texttt{:sharp}, or \texttt{:flat}) indicating
+whether staff positions corresponding to that note of the scale should
+be altered.  The default value for this initarg is a vector with seven
+elements, each begin the object \lispobj{:natural}.
 
 \Defun {make-fiveline-staff} {name \optional (clef \texttt(make-clef :treble))}
 



From rstrandh at common-lisp.net  Mon Oct 31 01:41:15 2005
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Mon, 31 Oct 2005 02:41:15 +0100 (CET)
Subject: [gsharp-cvs] CVS update: gsharp/play.lisp gsharp/buffer.lisp
	gsharp/drawing.lisp gsharp/gui.lisp gsharp/packages.lisp
	gsharp/system.lisp 
Message-ID: <20051031014115.34B9588549@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv27994

Modified Files:
	buffer.lisp drawing.lisp gui.lisp packages.lisp system.lisp 
Added Files:
	play.lisp 
Log Message:
Extracted midi-related computations to a new file: play.lisp

Renamed notehead-duration to undotted-duration, which better reflects
the intention.


Date: Mon Oct 31 02:41:13 2005
Author: rstrandh



Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.9 gsharp/buffer.lisp:1.10
--- gsharp/buffer.lisp:1.9	Thu Aug  5 08:31:57 2004
+++ gsharp/buffer.lisp	Mon Oct 31 02:41:13 2005
@@ -237,7 +237,7 @@
 	    ":notehead ~W :rbeams ~W :lbeams ~W :dots ~W :xoffset ~W "
 	    notehead rbeams lbeams dots xoffset)))
 
-(defmethod notehead-duration ((element element))
+(defmethod undotted-duration ((element element))
   (ecase (notehead element)
     (:whole 1)
     (:half 1/2)
@@ -245,7 +245,7 @@
 				  (lbeams element))))))))
 
 (defmethod element-duration ((element element))
-  (let ((duration (notehead-duration element)))
+  (let ((duration (undotted-duration element)))
     (do ((dot-duration (/ duration 2) (/ dot-duration 2))
 	 (nb-dots (dots element) (1- nb-dots)))
 	((zerop nb-dots))


Index: gsharp/drawing.lisp
diff -u gsharp/drawing.lisp:1.11 gsharp/drawing.lisp:1.12
--- gsharp/drawing.lisp:1.11	Fri Sep  2 18:10:03 2005
+++ gsharp/drawing.lisp	Mon Oct 31 02:41:13 2005
@@ -633,7 +633,7 @@
 (defmethod draw-element (pane (element rest) x &optional (flags t))
   (declare (ignore flags))
   (score-pane:with-vertical-score-position (pane (staff-yoffset (staff element)))
-    (score-pane:draw-rest pane (notehead-duration element) x (staff-pos element))
+    (score-pane:draw-rest pane (undotted-duration element) x (staff-pos element))
     (draw-dots pane (dots element) x (1+ (staff-pos element)))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.26 gsharp/gui.lisp:1.27
--- gsharp/gui.lisp:1.26	Fri Oct 28 19:20:19 2005
+++ gsharp/gui.lisp	Mon Oct 31 02:41:13 2005
@@ -528,86 +528,15 @@
  :menu '(("Buffer" :command com-play-buffer)
 	 ("Segment" :command com-play-segment)))
 
-(defun midi-pitch (note)
-  (+ (* 12 (+ (floor (pitch note) 7) 1))
-     (ecase (mod (pitch note) 7) (0 0) (1 2) (2 4) (3 5) (4 7) (5 9) (6 11))
-     (ecase (accidentals note)
-       (:double-flat -2) (:flat -1) (:natural 0) (:sharp 1) (:double-sharp 2))))
-
-(defun measure-durations (slices)
-  (let ((durations (mapcar (lambda (slice)
-			     (mapcar (lambda (bar)
-				       (reduce #'+ (elements bar)
-					       :key #'element-duration))
-				     (bars slice)))
-			   slices)))
-    (loop while durations
-	  collect (reduce #'max (mapcar #'car durations))
-	  do (setf durations (remove nil (mapcar #'cdr durations))))))
-
-(defun events-from-element (element time channel)
-  (when (typep element 'cluster)
-    (append (mapcar (lambda (note)
-		      (make-instance 'note-on-message
-				     :time time
-				     :status (+ #x90 channel)
-				     :key (midi-pitch note) :velocity 100))
-		    (notes element))
-	    (mapcar (lambda (note)
-		      (make-instance 'note-off-message
-				     :time (+ time (* 128 (element-duration element)))
-				     :status (+ #x80 channel)
-				     :key (midi-pitch note) :velocity 100))
-		    (notes element)))))
-
-(defun events-from-bar (bar time channel)
-  (mapcan (lambda (element)
-	    (prog1 (events-from-element element time channel)
-	      (incf time (* 128 (element-duration element)))))
-	  (elements bar)))
-
-(defun track-from-slice (slice channel durations)
-  (cons (make-instance 'program-change-message
-	  :time 0 :status  (+ #xc0 channel) :program 0)
-	(let ((time 0))
-	  (mapcan (lambda (bar duration)
-		    (prog1 (events-from-bar bar time channel)
-		      (incf time (* 128 duration))))
-		  (bars slice) durations))))
-
 (define-gsharp-command (com-play-segment :name t) ()
-  (let* ((slices (mapcar #'body (layers (car (segments (buffer *application-frame*))))))
-	 (durations (measure-durations slices))
-	 (tracks (loop for slice in slices
-		       for i from 0
-		       collect (track-from-slice slice i durations)))
-	 (midifile (make-instance 'midifile
-		     :format 1
-		     :division 25
-		     :tracks tracks)))
-    (write-midi-file midifile "test.mid")
-    #+cmu
-    (ext:run-program "timidity" '("test.mid"))
-    #+sbcl
-    (sb-ext:run-program "timidity" '("test.mid") :search t)
-    #-(or cmu sbcl)
-    (error "write compatibility layer for RUN-PROGRAM")))
+  (play-segment (segment (cursor *application-frame*))))
 
 (define-gsharp-command (com-play-layer :name t) ()
-  (let* ((slice (body (layer (cursor *application-frame*))))
-	 (durations (measure-durations (list slice)))
-	 (tracks (list (track-from-slice slice 0 durations)))
-	 (midifile (make-instance 'midifile
-		     :format 1
-		     :division 25
-		     :tracks tracks)))
-    (write-midi-file midifile "test.mid")
-    #+cmu
-    (ext:run-program "timidity" '("test.mid"))
-    #+sbcl
-    (sb-ext:run-program "timidity" '("test.mid") :search t)
-    #-(or cmu sbcl)
-    (error "write compatibility layer for RUN-PROGRAM")))
+  (play-layer (layer (cursor *application-frame*))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
+;;; main entry point
 
 (defun run-gsharp (&key (width 900) (height 600))
   (let* ((buffer (make-initialized-buffer))
@@ -621,21 +550,6 @@
 						  :width width :height height)))
       (setf (staves (car (layers (car (segments buffer))))) (list staff))
       (run-frame-top-level *application-frame*))))
-
-;; (defun run-gsharp ()
-;;  (loop for port in climi::*all-ports*
-;; 	do (destroy-port port))
-;;  (setq climi::*all-ports* nil)
-;;   (let* ((buffer (make-initialized-buffer))
-;; 	 (staff (car (staves buffer)))
-;; 	 (input-state (make-input-state))
-;; 	 (cursor (make-initial-cursor buffer)))
-;;     (setf *application-frame* (make-application-frame 'gsharp
-;; 						 :buffer buffer
-;; 						 :input-state input-state
-;; 						 :cursor cursor)
-;; 	  (staves (car (layers (car (segments buffer))))) (list staff)))
-;;   (run-frame-top-level *application-frame*))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.11 gsharp/packages.lisp:1.12
--- gsharp/packages.lisp:1.11	Thu Oct 13 11:05:04 2005
+++ gsharp/packages.lisp	Mon Oct 31 02:41:13 2005
@@ -66,7 +66,7 @@
 	   #:rename-staff
 	   #:add-staff-to-layer
 	   #:remove-staff-from-layer
-	   #:stem-direction #:stem-length #:notehead-duration #:element-duration
+	   #:stem-direction #:stem-length #:undotted-duration #:element-duration
 	   #:clef #:keysig #:staff-pos #:xoffset #:read-everything #:save-buffer-to-stream
 	   #:line-width #:min-width #:spacing-style #:right-edge #:left-offset
 	   #:left-margin #:text #:append-char #:erase-char
@@ -202,10 +202,18 @@
 	   #:header #:header-type
 	   #:unknown-event #:status #:data-byte))
 
+(defpackage :gsharp-play
+  (:use :common-lisp :midi :gsharp-buffer)
+  (:shadowing-import-from :gsharp-buffer #:rest)
+  (:export #:play-layer
+	   #:play-segment
+	   #:play-buffer))
+
 (defpackage :gsharp
   (:use :clim :clim-lisp :gsharp-utilities :esa
 	:gsharp-buffer :gsharp-cursor :gsharp-drawing :gsharp-numbering
-	:gsharp-measure :sdl :midi)
+	:gsharp-measure :sdl :midi
+	:gsharp-play)
   (:shadowing-import-from :gsharp-numbering #:number)
   (:shadowing-import-from :gsharp-buffer #:rest))
 


Index: gsharp/system.lisp
diff -u gsharp/system.lisp:1.7 gsharp/system.lisp:1.8
--- gsharp/system.lisp:1.7	Mon Jul 25 13:14:38 2005
+++ gsharp/system.lisp	Mon Oct 31 02:41:13 2005
@@ -40,4 +40,5 @@
    "input-state"
    "midi"
    "modes"
+   "play"
    "gui")



From rstrandh at common-lisp.net  Mon Oct 31 01:49:48 2005
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Mon, 31 Oct 2005 02:49:48 +0100 (CET)
Subject: [gsharp-cvs] CVS update: gsharp/gui.lisp gsharp/packages.lisp 
Message-ID: <20051031014948.5FBC488549@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv29044

Modified Files:
	gui.lisp packages.lisp 
Log Message:
Improve and rename main entry point to `gsharp'.  Export that symbol from
the gsharp package.


Date: Mon Oct 31 02:49:47 2005
Author: rstrandh

Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.27 gsharp/gui.lisp:1.28
--- gsharp/gui.lisp:1.27	Mon Oct 31 02:41:13 2005
+++ gsharp/gui.lisp	Mon Oct 31 02:49:47 2005
@@ -538,18 +538,24 @@
 ;;;
 ;;; main entry point
 
-(defun run-gsharp (&key (width 900) (height 600))
+(defun gsharp (&key new-process (process-name "Gsharp")
+	       (width 900) (height 600))
+  "Start a Gsharp session" 
   (let* ((buffer (make-initialized-buffer))
 	 (staff (car (staves buffer)))
 	 (input-state (make-input-state))
 	 (cursor (make-initial-cursor buffer)))
-    (let ((*application-frame* (make-application-frame 'gsharp
-						  :buffer buffer
-						  :input-state input-state
-						  :cursor cursor
-						  :width width :height height)))
-      (setf (staves (car (layers (car (segments buffer))))) (list staff))
-      (run-frame-top-level *application-frame*))))
+    (let ((frame (make-application-frame 'gsharp
+					 :buffer buffer
+					 :input-state input-state
+					 :cursor cursor
+					 :width width :height height)))
+      (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))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.12 gsharp/packages.lisp:1.13
--- gsharp/packages.lisp:1.12	Mon Oct 31 02:41:13 2005
+++ gsharp/packages.lisp	Mon Oct 31 02:49:47 2005
@@ -215,7 +215,8 @@
 	:gsharp-measure :sdl :midi
 	:gsharp-play)
   (:shadowing-import-from :gsharp-numbering #:number)
-  (:shadowing-import-from :gsharp-buffer #:rest))
+  (:shadowing-import-from :gsharp-buffer #:rest)
+  (:export #:gsharp))
 
 (in-package :gsharp-numbering)
 (deftype number () 'cl:number)



From rstrandh at common-lisp.net  Mon Oct 31 02:16:29 2005
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Mon, 31 Oct 2005 03:16:29 +0100 (CET)
Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/measure.lisp
	gsharp/packages.lisp gsharp/play.lisp 
Message-ID: <20051031021629.5891088549@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv30200

Modified Files:
	buffer.lisp measure.lisp packages.lisp play.lisp 
Log Message:
Got rid of ELEMENT-DURATION in favor of just DURATION by converting
a :before method to an :around method.



Date: Mon Oct 31 03:16:27 2005
Author: rstrandh

Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.10 gsharp/buffer.lisp:1.11
--- gsharp/buffer.lisp:1.10	Mon Oct 31 02:41:13 2005
+++ gsharp/buffer.lisp	Mon Oct 31 03:16:27 2005
@@ -244,7 +244,7 @@
     (:filled (/ (expt 2 (+ 2 (max (rbeams element)
 				  (lbeams element))))))))
 
-(defmethod element-duration ((element element))
+(defmethod duration ((element element))
   (let ((duration (undotted-duration element)))
     (do ((dot-duration (/ duration 2) (/ dot-duration 2))
 	 (nb-dots (dots element) (1- nb-dots)))


Index: gsharp/measure.lisp
diff -u gsharp/measure.lisp:1.3 gsharp/measure.lisp:1.4
--- gsharp/measure.lisp:1.3	Fri Jul 23 18:51:16 2004
+++ gsharp/measure.lisp	Mon Oct 31 03:16:27 2005
@@ -21,16 +21,17 @@
 ;;; a `duration' slot that contains the duration of the element. 
 ;;; It also makes sure that whenever the duration of an element
 ;;; is being asked for, the new value is computed should any 
-;;; modification to the element have taken placed in the meantime. 
+;;; modification to the element have taken place in the meantime. 
 
 (defrclass relement element
-  ((duration :initform nil :reader duration)))
+  ((duration :initform nil)))
 
-(defmethod duration :before ((element relement))
+(defmethod duration :around ((element relement))
   (with-slots (duration) element
     (when (or (modified-p element) (null duration))
-      (setf duration (element-duration element))
-      (setf (modified-p element) nil))))
+      (setf duration (call-next-method))
+      (setf (modified-p element) nil))
+    duration))
 
 (defmethod mark-modified ((element relement))
   (setf (modified-p element) t)


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.13 gsharp/packages.lisp:1.14
--- gsharp/packages.lisp:1.13	Mon Oct 31 02:49:47 2005
+++ gsharp/packages.lisp	Mon Oct 31 03:16:27 2005
@@ -66,7 +66,7 @@
 	   #:rename-staff
 	   #:add-staff-to-layer
 	   #:remove-staff-from-layer
-	   #:stem-direction #:stem-length #:undotted-duration #:element-duration
+	   #:stem-direction #:stem-length #:undotted-duration #:duration
 	   #:clef #:keysig #:staff-pos #:xoffset #:read-everything #:save-buffer-to-stream
 	   #:line-width #:min-width #:spacing-style #:right-edge #:left-offset
 	   #:left-margin #:text #:append-char #:erase-char
@@ -91,7 +91,7 @@
   (:use :common-lisp :gsharp-numbering :gsharp-buffer :gsharp-utilities :obseq)
   (:shadowing-import-from :gsharp-numbering #:number)
   (:shadowing-import-from :gsharp-buffer #:rest)
-  (:export #:mark-modified #:modified-p #:duration #:measure
+  (:export #:mark-modified #:modified-p #:measure
 	   #:measure-min-dist #:measure-coeff #:measure-start-times
 	   #:measure-bar-pos #:measure-seg-pos #:measure-bars #:measures
 	   #:nb-measures #:measureno


Index: gsharp/play.lisp
diff -u gsharp/play.lisp:1.1 gsharp/play.lisp:1.2
--- gsharp/play.lisp:1.1	Mon Oct 31 02:41:13 2005
+++ gsharp/play.lisp	Mon Oct 31 03:16:27 2005
@@ -10,7 +10,7 @@
   (let ((durations (mapcar (lambda (slice)
 			     (mapcar (lambda (bar)
 				       (reduce #'+ (elements bar)
-					       :key #'element-duration))
+					       :key #'duration))
 				     (bars slice)))
 			   slices)))
     (loop while durations
@@ -27,7 +27,7 @@
 		    (notes element))
 	    (mapcar (lambda (note)
 		      (make-instance 'note-off-message
-				     :time (+ time (* 128 (element-duration element)))
+				     :time (+ time (* 128 (duration element)))
 				     :status (+ #x80 channel)
 				     :key (midi-pitch note) :velocity 100))
 		    (notes element)))))
@@ -35,7 +35,7 @@
 (defun events-from-bar (bar time channel)
   (mapcan (lambda (element)
 	    (prog1 (events-from-element element time channel)
-	      (incf time (* 128 (element-duration element)))))
+	      (incf time (* 128 (duration element)))))
 	  (elements bar)))
 
 (defun track-from-slice (slice channel durations)



From crhodes at common-lisp.net  Mon Oct 31 14:42:36 2005
From: crhodes at common-lisp.net (Christophe Rhodes)
Date: Mon, 31 Oct 2005 15:42:36 +0100 (CET)
Subject: [gsharp-cvs] CVS update: gsharp/Doc/Makefile gsharp/Doc/buffer.tex
	gsharp/Doc/tex-dependencies 
Message-ID: <20051031144236.1CA0F8856F@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp/Doc
In directory common-lisp.net:/tmp/cvs-serv19226

Modified Files:
	Makefile buffer.tex tex-dependencies 
Log Message:
Documentation build fixes

Date: Mon Oct 31 15:42:34 2005
Author: crhodes

Index: gsharp/Doc/Makefile
diff -u gsharp/Doc/Makefile:1.2 gsharp/Doc/Makefile:1.3
--- gsharp/Doc/Makefile:1.2	Tue Feb 24 06:30:47 2004
+++ gsharp/Doc/Makefile	Mon Oct 31 15:42:34 2005
@@ -1,8 +1,8 @@
 NAME=gsharp
 
-TEXFILES=$(NAME).tex $(shell tex-dependencies $(NAME).tex)
-PSTEX_T=$(shell strip-dependence inputfig $(TEXFILES))
-VERBATIM=$(shell strip-dependence verbatimtabinput $(TEXFILES))
+TEXFILES=$(NAME).tex $(shell ./tex-dependencies $(NAME).tex)
+PSTEX_T=$(shell ./strip-dependence inputfig $(TEXFILES))
+VERBATIM=$(shell ./strip-dependence verbatimtabinput $(TEXFILES))
 PSTEX=$(subst .pstex_t,.pstex,$(PSTEX_T))
 
 all : $(NAME).ps


Index: gsharp/Doc/buffer.tex
diff -u gsharp/Doc/buffer.tex:1.3 gsharp/Doc/buffer.tex:1.4
--- gsharp/Doc/buffer.tex:1.3	Mon Oct 31 02:39:23 2005
+++ gsharp/Doc/buffer.tex	Mon Oct 31 15:42:34 2005
@@ -90,7 +90,7 @@
 This initarg indicates the name of the staff to be used.  The name of
 a staff must be unique and usually has some relationship to the
 instruments(s) displayed on it.  Examples of staff names would be
-``1st violin'', ``soprano & alto'', etc.  The default value for this
+``1st violin'', ``soprano \& alto'', etc.  The default value for this
 initarg is \lispobj{"default staff"}.
 
 \Defgeneric {name} {staff}


Index: gsharp/Doc/tex-dependencies
diff -u gsharp/Doc/tex-dependencies:1.1.1.1 gsharp/Doc/tex-dependencies:1.2
--- gsharp/Doc/tex-dependencies:1.1.1.1	Mon Feb 16 16:46:31 2004
+++ gsharp/Doc/tex-dependencies	Mon Oct 31 15:42:34 2005
@@ -1,10 +1,10 @@
 #!/bin/sh
 
 #set -x
-TEXFILES=$(strip-dependence inputtex $1)
+TEXFILES=$(./strip-dependence inputtex $1)
 echo -n $TEXFILES
 for i in $TEXFILES
 do
-    echo -n $(tex-dependencies $i)
+    echo -n $(./tex-dependencies $i)
 done
 echo



From rstrandh at common-lisp.net  Mon Oct 31 18:23:47 2005
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Mon, 31 Oct 2005 19:23:47 +0100 (CET)
Subject: [gsharp-cvs] CVS update: gsharp/Doc/buffer.tex 
Message-ID: <20051031182347.BFEF188570@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp/Doc
In directory common-lisp.net:/tmp/cvs-serv3392

Modified Files:
	buffer.tex 
Log Message:
Improvements to the documentation of buffer protocols.

Date: Mon Oct 31 19:23:47 2005
Author: rstrandh

Index: gsharp/Doc/buffer.tex
diff -u gsharp/Doc/buffer.tex:1.4 gsharp/Doc/buffer.tex:1.5
--- gsharp/Doc/buffer.tex:1.4	Mon Oct 31 15:42:34 2005
+++ gsharp/Doc/buffer.tex	Mon Oct 31 19:23:47 2005
@@ -67,11 +67,6 @@
 The reader accepts this syntax, except that the slots can come in any
 arbitrary order. 
 
-In version 2 of the external representation, a clef was written like
-this :
-
-\texttt{[K \textit{name} \textit{lineno} ]}
-
 %===================================================================
 \section{The staff protocol}
 
@@ -100,13 +95,13 @@
 
 \Defclass {fiveline-staff}
 
-This class is a subclass of \texttt{staff} and is used to represent an
+This class is a subclass of \lispobj{staff}, and is used to represent an
 ordinary five-line staff for displaying notes. 
 
 \Definitarg {:clef}
 
 This value must always be supplied, and must be an instance of the
-class \texttt{clef}.  The clef of a five-line staff indicates where
+class \lispobj{clef}.  The clef of a five-line staff indicates where
 on the staff notes are to be displayed.  
 
 \Definitarg {:keysig}
@@ -114,12 +109,12 @@
 This initarg is used to represent the key signature of the staff.  The
 value is a vector with seven elements, where each element corresponds
 to a note of the scale (C, D, E, F, G, A, B), and is a keyword
-(\texttt{:natural}, \texttt{:sharp}, or \texttt{:flat}) indicating
+(\lispobj{:natural}, \lispobj{:sharp}, or \lispobj{:flat}) indicating
 whether staff positions corresponding to that note of the scale should
 be altered.  The default value for this initarg is a vector with seven
 elements, each begin the object \lispobj{:natural}.
 
-\Defun {make-fiveline-staff} {name \optional (clef \texttt(make-clef :treble))}
+\Defun {make-fiveline-staff} {name \optional (clef \lispobj(make-clef :treble))}
 
 \Defgeneric {clef} {fiveline-staff}
 
@@ -131,6 +126,11 @@
 Return the key signature of the staff.  With \lispobj{setf}, change
 the key signature of the staff. 
 
+\Defclass {lyrics-staff}
+
+This class is a subclass of \lispobj{staff}, and is used to represent a
+staff for displaying lyrics. 
+
 %-------------------------------------------------------------------
 \subsection{External representation}
 
@@ -142,10 +142,10 @@
 The reader accepts this syntax, except that the slots can come in any
 arbitrary order. 
 
-In version 2 of the external representation, a staff was written like
-this :
+A lyrics staff is printed (by \lispobj{print-object}) like this in
+version 3 of the external representation:
 
-\texttt{[= \textit{clef} \textit{keysig} ]}
+\texttt{[L :name \textit{name} ]}
 
 %===================================================================
 \section{The keysig protocol}
@@ -154,3 +154,39 @@
 keysig would be a read-only object.  
 
 %===================================================================
+\section{The note protocol}
+
+%-------------------------------------------------------------------
+\subsection{Description}
+
+Notes are immutable objects.  For that reason, if you want to change
+some characteristics of a note in a cluster, you have to delete the
+note from the cluster and create one with the characteristics you
+would like. 
+
+%-------------------------------------------------------------------
+\subsection{Protocol classes and functions}
+
+\Defclass{note}
+
+The protocol class for notes. 
+
+
+%-------------------------------------------------------------------
+\subsection{External representation}
+
+A note is printed (by \lispobj{print-object}
+
+\Definitarg{:cluster}
+
+This initarg determines the cluster to which the note belongs.  The
+default value for this initarg is \lispobj{nil} indicating that the
+note currently does not belong to any cluster.
+
+\Definitarg{:pitch}
+
+This initarg is mandatory, and determines the pitch of the note.
+A pitch is indicated as an integer between 0 and 127, where 0 means a
+C in the lowest octave possible. 
+
+\Definitarg{:staff}
\ No newline at end of file



From rstrandh at common-lisp.net  Mon Oct 31 18:24:40 2005
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Mon, 31 Oct 2005 19:24:40 +0100 (CET)
Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp
	gsharp/packages.lisp 
Message-ID: <20051031182440.ACD8088570@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv3417

Modified Files:
	buffer.lisp gui.lisp packages.lisp 
Log Message:
Removed the function MAKE-NOTE in favor of MAKE-INSTANCE 'NOTE

Date: Mon Oct 31 19:24:39 2005
Author: rstrandh

Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.11 gsharp/buffer.lisp:1.12
--- gsharp/buffer.lisp:1.11	Mon Oct 31 03:16:27 2005
+++ gsharp/buffer.lisp	Mon Oct 31 19:24:39 2005
@@ -132,29 +132,12 @@
 ;;; currently does not belong to any cluster. 
 (defgeneric cluster (note))
 
-(defclass note (gsharp-object)
-  ((print-character :allocation :class :initform #\N)
-   (cluster :initform nil :initarg :cluster :accessor cluster)
-   (pitch :initarg :pitch :reader pitch)
-   (staff :initarg :staff :reader staff)
-   (head :initarg :head :reader head)
-   (accidentals :initarg :accidentals :reader accidentals)
-   (dots :initarg :dots :reader dots)))
-
-(defmethod print-object :after ((n note) stream)
-  (with-slots (pitch staff head accidentals dots) n
-    (format stream
-	    ":pitch ~W :staff ~W :head ~W :accidentals ~W :dots ~W "
-	    pitch staff head accidentals dots)))
-
-;;; Make a note with the pitch and staff given.  
-;;; 
 ;;; The pitch is a number from 0 to 128
 ;;; 
 ;;; The staff is a staff object. 
 ;;; 
 ;;; Head can be :whole, :half, :filled, or nil.  A value of nil means
-;;; that the note head is determined by that of the cluster to which the
+;;; that the notehead is determined by that of the cluster to which the
 ;;; note belongs. 
 ;;; 
 ;;; Accidentals can be :natural :flat :double-flat :sharp or :double-sharp.
@@ -163,22 +146,27 @@
 ;;; display style. 
 ;;; 
 ;;; The number of dots can be an integer or nil, meaning that the number
-;;; of dots is taken from the cluster. 
+;;; of dots is taken from the cluster.  The default value is nil.
 ;;; 
 ;;; The actual duration of the note is computed from the note head, the
 ;;; number of beams of the cluster to which the note belongs, and the
 ;;; number of dots in the usual way. 
-(defun make-note (pitch &optional staff
-		  (head nil) (accidentals :natural) (dots nil))
-  (declare (type (integer 0 128) pitch)
-	   (type (or staff null) staff)
-	   (type (or (member :whole :half :filled) null) head)
-	   (type (member :natural :flat :double-flat :sharp :double-sharp) accidentals)
-	   (type (or integer null) dots))
-    (make-instance 'note
-      :pitch pitch :staff staff
-      :head head :accidentals accidentals :dots dots))
-		 
+
+(defclass note (gsharp-object)
+  ((print-character :allocation :class :initform #\N)
+   (cluster :initform nil :initarg :cluster :accessor cluster)
+   (pitch :initarg :pitch :reader pitch)
+   (staff :initarg :staff :reader staff)
+   (head :initform nil :initarg :head :reader head)
+   (accidentals :initform :natural :initarg :accidentals :reader accidentals)
+   (dots :initform nil :initarg :dots :reader dots)))
+
+(defmethod print-object :after ((n note) stream)
+  (with-slots (pitch staff head accidentals dots) n
+    (format stream
+	    ":pitch ~W :staff ~W :head ~W :accidentals ~W :dots ~W "
+	    pitch staff head accidentals dots)))
+
 (defun read-note-v3 (stream char n)
   (declare (ignore char n))
   (apply #'make-instance 'note (read-delimited-list #\] stream t)))


Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.28 gsharp/gui.lisp:1.29
--- gsharp/gui.lisp:1.28	Mon Oct 31 02:49:47 2005
+++ gsharp/gui.lisp	Mon Oct 31 19:24:39 2005
@@ -579,11 +579,12 @@
 (defun insert-note (pitch cluster)
   (let* ((state (input-state *application-frame*))
 	 (staff (car (staves (layer (slice (bar cluster))))))
-	 (note (make-note pitch
-			  staff
-			  (notehead state)
-			  (aref (keysig staff) (mod pitch 7))
-			  (dots state))))
+	 (note (make-instance 'note
+		 :pitch pitch
+		 :staff staff
+		 :head (notehead state)
+		 :accidentals (aref (keysig staff) (mod pitch 7))
+		 :dots (dots state))))
     (setf *current-cluster* cluster
 	  *current-note* note)
     (add-note cluster note)))
@@ -732,11 +733,12 @@
   (let ((element (cur-element)))
     (if (typep element 'cluster)
 	(let* ((note (cur-note))
-	       (new-note (make-note (1- (pitch note))
-				    (staff note)
-				    (head note)
-				    (accidentals note)
-				    (dots note))))
+	       (new-note (make-instance 'note
+			   :pitch (1- (pitch note))
+			   :staff (staff note)
+			   :head (head note)
+			   :accidentals (accidentals note)
+			   :dots (dots note))))
 	  (remove-note note)
 	  (add-note element new-note)
 	  (setf *current-note* new-note))
@@ -760,11 +762,12 @@
   (let ((element (cur-element)))
     (if (typep element 'cluster)
 	(let* ((note (cur-note))
-	       (new-note (make-note (1+ (pitch note))
-				    (staff note)
-				    (head note)
-				    (accidentals note)
-				    (dots note))))
+	       (new-note (make-instance 'note
+			   :pitch (1+ (pitch note))
+			   :staff (staff note)
+			   :head (head note)
+			   :accidentals (accidentals note)
+			   :dots (dots note))))
 	  (remove-note note)
 	  (add-note element new-note)
 	  (setf *current-note* new-note))
@@ -787,16 +790,17 @@
 (define-gsharp-command com-sharper ()
   (let* ((cluster (cur-cluster))
 	 (note (cur-note))
-	 (new-note (make-note (pitch note)
-			      (staff note)
-			      (head note)
-			      (ecase (accidentals note)
-				(:double-sharp :double-sharp)
-				(:sharp :double-sharp)
-				(:natural :sharp)
-				(:flat :natural)
-				(:double-flat :flat))
-			      (dots note))))
+	 (new-note (make-instance 'note
+		     :pitch (pitch note)
+		     :staff (staff note)
+		     :head (head note)
+		     :accidentals (ecase (accidentals note)
+				    (:double-sharp :double-sharp)
+				    (:sharp :double-sharp)
+				    (:natural :sharp)
+				    (:flat :natural)
+				    (:double-flat :flat))
+		     :dots (dots note))))
     (remove-note note)
     (add-note cluster new-note)
     (setf *current-note* new-note)))
@@ -804,16 +808,17 @@
 (define-gsharp-command com-flatter ()
   (let* ((cluster (cur-cluster))
 	 (note (cur-note))
-	 (new-note (make-note (pitch note)
-			      (staff note)
-			      (head note)
-			      (ecase (accidentals note)
-				(:double-sharp :sharp)
-				(:sharp :natural)
-				(:natural :flat)
-				(:flat :double-flat)
-				(:double-flat :double-flat))
-			      (dots note))))
+	 (new-note (make-instance 'note
+		     :pitch (pitch note)
+		     :staff (staff note)
+		     :head (head note)
+		     :accidentals (ecase (accidentals note)
+				    (:double-sharp :sharp)
+				    (:sharp :natural)
+				    (:natural :flat)
+				    (:flat :double-flat)
+				    (:double-flat :double-flat))
+		     :dots (dots note))))
     (remove-note note)
     (add-note cluster new-note)
     (setf *current-note* new-note)))


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.14 gsharp/packages.lisp:1.15
--- gsharp/packages.lisp:1.14	Mon Oct 31 03:16:27 2005
+++ gsharp/packages.lisp	Mon Oct 31 19:24:39 2005
@@ -41,7 +41,7 @@
 	   #:lyrics-staff #:make-lyrics-staff
 	   #:gsharp-condition
 	   #:pitch #:accidentals #:dots #:note
-	   #:make-note #:note-less #:note-equal #:bar
+	   #:note-less #:note-equal #:bar
 	   #:notehead #:rbeams #:lbeams #:dots #:element
 	   #:melody-element #:notes
 	   #:add-note #:find-note #:remove-note #:cluster #:make-cluster



From rstrandh at common-lisp.net  Mon Oct 31 19:01:16 2005
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Mon, 31 Oct 2005 20:01:16 +0100 (CET)
Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp 
Message-ID: <20051031190116.F3AA788570@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv6122

Modified Files:
	buffer.lisp 
Log Message:
put back the lost type information, this time in the class definition

Date: Mon Oct 31 20:01:16 2005
Author: rstrandh

Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.12 gsharp/buffer.lisp:1.13
--- gsharp/buffer.lisp:1.12	Mon Oct 31 19:24:39 2005
+++ gsharp/buffer.lisp	Mon Oct 31 20:01:16 2005
@@ -155,11 +155,15 @@
 (defclass note (gsharp-object)
   ((print-character :allocation :class :initform #\N)
    (cluster :initform nil :initarg :cluster :accessor cluster)
-   (pitch :initarg :pitch :reader pitch)
-   (staff :initarg :staff :reader staff)
-   (head :initform nil :initarg :head :reader head)
-   (accidentals :initform :natural :initarg :accidentals :reader accidentals)
-   (dots :initform nil :initarg :dots :reader dots)))
+   (pitch :initarg :pitch :reader pitch :type (integer 0 128))
+   (staff :initarg :staff :reader staff :type (or staff null))
+   (head :initform nil :initarg :head :reader head
+	 :type (or (member :whole :half :filled) null))
+   (accidentals :initform :natural :initarg :accidentals :reader accidentals
+		:type (member :natural :flat :double-flat
+			      :sharp :double-sharp))
+   (dots :initform nil :initarg :dots :reader dots
+	 :type (or integer null))))
 
 (defmethod print-object :after ((n note) stream)
   (with-slots (pitch staff head accidentals dots) n



From rstrandh at common-lisp.net  Mon Oct 31 19:55:31 2005
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Mon, 31 Oct 2005 20:55:31 +0100 (CET)
Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp
	gsharp/packages.lisp 
Message-ID: <20051031195531.72DCF88575@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv9736

Modified Files:
	buffer.lisp gui.lisp packages.lisp 
Log Message:
Removed MAKE-CLEF in favor of MAKE-INSTANCE 'CLEF 

Date: Mon Oct 31 20:55:30 2005
Author: rstrandh

Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.13 gsharp/buffer.lisp:1.14
--- gsharp/buffer.lisp:1.13	Mon Oct 31 20:01:16 2005
+++ gsharp/buffer.lisp	Mon Oct 31 20:55:30 2005
@@ -35,23 +35,24 @@
 
 (defclass clef (gsharp-object name-mixin)
   ((print-character :allocation :class :initform #\K)
-   (lineno :reader lineno :initarg :lineno :initform nil)))
+   (lineno :reader lineno :initarg :lineno
+	   :type (or (integer 2 6) null))))
 
+(defmethod initialize-instance :after ((c clef) &rest args)
+  (declare (ignore args))
+  (with-slots (lineno name) c
+    (check-type name (member :treble :bass :c :percussion))
+    (unless (slot-boundp c 'lineno)
+      (setf lineno
+	    (ecase name
+	      (:treble 2)
+	      (:bass 6)
+	      (:c 4)
+	      (:percussion 3))))))
+  
 (defmethod print-object :after ((c clef) stream)
   (format stream ":lineno ~W " (lineno c)))
 
-(defun make-clef (name &optional lineno)
-  (declare (type (member :treble :bass :c :percussion) name)
-	   (type (or (integer 2 6) null) lineno))
-  (make-instance 'clef
-		 :name name
-		 :lineno (or lineno
-			     (ecase name
-			       (:treble 2)
-			       (:bass 6)
-			       (:c 4)
-			       (:percussion 3)))))
-
 (defun read-clef-v3 (stream char n)
   (declare (ignore char n))
   (apply #'make-instance 'clef (read-delimited-list #\] stream t)))
@@ -81,7 +82,7 @@
 (defmethod print-object :after ((s fiveline-staff) stream)
   (format stream ":clef ~W :keysig ~W " (clef s) (keysig s)))
 
-(defun make-fiveline-staff (name &optional (clef (make-clef :treble)))
+(defun make-fiveline-staff (name &optional (clef (make-instance 'clef :name :treble)))
   (make-instance 'fiveline-staff :name name :clef clef))
 
 (defun read-fiveline-staff-v3 (stream char n)


Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.29 gsharp/gui.lisp:1.30
--- gsharp/gui.lisp:1.29	Mon Oct 31 19:24:39 2005
+++ gsharp/gui.lisp	Mon Oct 31 20:55:30 2005
@@ -923,7 +923,7 @@
   (let ((staff (accept 'score-pane:fiveline-staff :prompt "Set clef of staff"))
 	(type (accept 'clef-type :prompt "Type of clef"))
 	(line (accept 'integer :prompt "Line of clef")))
-    (setf (clef staff) (make-clef type line))))
+    (setf (clef staff) (make-instance 'clef :name type :lineno line))))
 
 (define-gsharp-command com-higher ()
   (incf (last-note (input-state *application-frame*)) 7))
@@ -1052,7 +1052,7 @@
     (ecase (accept 'staff-type :prompt "Type")
       (:fiveline (let ((clef (accept 'clef-type :prompt "Clef type of new staff"))
 		       (line (accept 'integer :prompt "Line of clef")))
-		   (make-fiveline-staff name (make-clef clef line))))
+		   (make-fiveline-staff name (make-instance 'clef :name clef :lineno line))))
       (:lyrics (make-lyrics-staff name)))))
 
 (define-gsharp-command (com-insert-staff-before :name t) ()


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.15 gsharp/packages.lisp:1.16
--- gsharp/packages.lisp:1.15	Mon Oct 31 19:24:39 2005
+++ gsharp/packages.lisp	Mon Oct 31 20:55:30 2005
@@ -36,7 +36,7 @@
 (defpackage :gsharp-buffer
   (:use :common-lisp :gsharp-utilities)
   (:shadow #:rest)
-  (:export #:clef #:make-clef #:name #:lineno
+  (:export #:clef #:name #:lineno
 	   #:staff #:fiveline-staff #:make-fiveline-staff
 	   #:lyrics-staff #:make-lyrics-staff
 	   #:gsharp-condition



From rstrandh at common-lisp.net  Mon Oct 31 20:16:56 2005
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Mon, 31 Oct 2005 21:16:56 +0100 (CET)
Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp
	gsharp/packages.lisp 
Message-ID: <20051031201656.405CF88575@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv11680

Modified Files:
	buffer.lisp gui.lisp packages.lisp 
Log Message:
Removed the function MAKE-FIVELINE-STAFF in favor of 
MAKE-INSTANCE 'FIVELINE-STAFF.

Date: Mon Oct 31 21:16:54 2005
Author: rstrandh

Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.14 gsharp/buffer.lisp:1.15
--- gsharp/buffer.lisp:1.14	Mon Oct 31 20:55:30 2005
+++ gsharp/buffer.lisp	Mon Oct 31 21:16:51 2005
@@ -75,16 +75,15 @@
 
 (defclass fiveline-staff (staff)
   ((print-character :allocation :class :initform #\=)
-   (clef :accessor clef :initarg :clef :initform nil)
+   (clef :accessor clef :initarg :clef :initform (make-instance 'clef :name :treble))
    (keysig :accessor keysig :initarg :keysig
-	   :initform (make-array 7 :initial-element :natural))))
+	   :initform (make-array 7 :initial-element :natural)))
+  (:default-initargs
+      :name "default staff"))
 	   
 (defmethod print-object :after ((s fiveline-staff) stream)
   (format stream ":clef ~W :keysig ~W " (clef s) (keysig s)))
 
-(defun make-fiveline-staff (name &optional (clef (make-instance 'clef :name :treble)))
-  (make-instance 'fiveline-staff :name name :clef clef))
-
 (defun read-fiveline-staff-v3 (stream char n)
   (declare (ignore char n))
   (apply #'make-instance 'fiveline-staff (read-delimited-list #\] stream t)))
@@ -874,7 +873,7 @@
 (defclass buffer (gsharp-object)
   ((print-character :allocation :class :initform #\B)
    (segments :initform '() :initarg :segments :accessor segments)
-   (staves :initform (list (make-fiveline-staff "default staff"))
+   (staves :initform (list (make-instance 'fiveline-staff))
 	   :initarg :staves :accessor staves)
    (min-width :initform *default-min-width* :initarg :min-width :accessor min-width)
    (spacing-style :initform *default-spacing-style* :initarg :spacing-style :accessor spacing-style)


Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.30 gsharp/gui.lisp:1.31
--- gsharp/gui.lisp:1.30	Mon Oct 31 20:55:30 2005
+++ gsharp/gui.lisp	Mon Oct 31 21:16:51 2005
@@ -1050,9 +1050,10 @@
 (defun acquire-new-staff ()
   (let ((name (acquire-unique-staff-name "Name of new staff")))
     (ecase (accept 'staff-type :prompt "Type")
-      (:fiveline (let ((clef (accept 'clef-type :prompt "Clef type of new staff"))
-		       (line (accept 'integer :prompt "Line of clef")))
-		   (make-fiveline-staff name (make-instance 'clef :name clef :lineno line))))
+      (:fiveline (let* ((clef-name (accept 'clef-type :prompt "Clef type of new staff"))
+			(line (accept 'integer :prompt "Line of clef"))
+			(clef (make-instance 'clef :name clef-name :lineno line)))
+		   (make-instance 'fiveline-staff :name name :clef clef)))
       (:lyrics (make-lyrics-staff name)))))
 
 (define-gsharp-command (com-insert-staff-before :name t) ()


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.16 gsharp/packages.lisp:1.17
--- gsharp/packages.lisp:1.16	Mon Oct 31 20:55:30 2005
+++ gsharp/packages.lisp	Mon Oct 31 21:16:51 2005
@@ -37,7 +37,7 @@
   (:use :common-lisp :gsharp-utilities)
   (:shadow #:rest)
   (:export #:clef #:name #:lineno
-	   #:staff #:fiveline-staff #:make-fiveline-staff
+	   #:staff #:fiveline-staff
 	   #:lyrics-staff #:make-lyrics-staff
 	   #:gsharp-condition
 	   #:pitch #:accidentals #:dots #:note



From rstrandh at common-lisp.net  Mon Oct 31 20:38:50 2005
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Mon, 31 Oct 2005 21:38:50 +0100 (CET)
Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp
	gsharp/packages.lisp 
Message-ID: <20051031203850.51499880DB@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv13028

Modified Files:
	buffer.lisp gui.lisp packages.lisp 
Log Message:
Removed the function MAKE-LYRICS-STAFF in favor of 
MAKE-INSTANCE 'LYRICS-STAFF

Date: Mon Oct 31 21:38:49 2005
Author: rstrandh

Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.15 gsharp/buffer.lisp:1.16
--- gsharp/buffer.lisp:1.15	Mon Oct 31 21:16:51 2005
+++ gsharp/buffer.lisp	Mon Oct 31 21:38:49 2005
@@ -97,9 +97,6 @@
 (defclass lyrics-staff (staff)
   ((print-character :allocation :class :initform #\L)))
 
-(defun make-lyrics-staff (name)
-  (make-instance 'lyrics-staff :name name))
-
 (defun read-lyrics-staff-v3 (stream char n)
   (declare (ignore char n))
   (apply #'make-instance 'lyrics-staff (read-delimited-list #\] stream t)))


Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.31 gsharp/gui.lisp:1.32
--- gsharp/gui.lisp:1.31	Mon Oct 31 21:16:51 2005
+++ gsharp/gui.lisp	Mon Oct 31 21:38:49 2005
@@ -1054,7 +1054,7 @@
 			(line (accept 'integer :prompt "Line of clef"))
 			(clef (make-instance 'clef :name clef-name :lineno line)))
 		   (make-instance 'fiveline-staff :name name :clef clef)))
-      (:lyrics (make-lyrics-staff name)))))
+      (:lyrics (make-instance 'lyrics-staff :name name)))))
 
 (define-gsharp-command (com-insert-staff-before :name t) ()
   (add-staff-before-staff (accept 'score-pane:staff :prompt "Insert staff before staff")


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.17 gsharp/packages.lisp:1.18
--- gsharp/packages.lisp:1.17	Mon Oct 31 21:16:51 2005
+++ gsharp/packages.lisp	Mon Oct 31 21:38:49 2005
@@ -38,7 +38,7 @@
   (:shadow #:rest)
   (:export #:clef #:name #:lineno
 	   #:staff #:fiveline-staff
-	   #:lyrics-staff #:make-lyrics-staff
+	   #:lyrics-staff
 	   #:gsharp-condition
 	   #:pitch #:accidentals #:dots #:note
 	   #:note-less #:note-equal #:bar



From rstrandh at common-lisp.net  Mon Oct 31 20:48:18 2005
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Mon, 31 Oct 2005 21:48:18 +0100 (CET)
Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp
	gsharp/packages.lisp 
Message-ID: <20051031204818.58782880DB@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv14087

Modified Files:
	buffer.lisp gui.lisp packages.lisp 
Log Message:
Removed MAKE-CLUSTER and MAKE-REST in favor of
MAKE-INSTANCE 'CLUSTER and MAKE-INSTANCE 'REST

Date: Mon Oct 31 21:48:17 2005
Author: rstrandh

Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.16 gsharp/buffer.lisp:1.17
--- gsharp/buffer.lisp:1.16	Mon Oct 31 21:38:49 2005
+++ gsharp/buffer.lisp	Mon Oct 31 21:48:17 2005
@@ -282,11 +282,6 @@
   (with-slots (stem-direction notes) c
     (format stream ":stem-direction ~W :notes ~W " stem-direction notes)))
 
-(defun make-cluster (rbeams lbeams dots notehead stem-direction)
-  (make-instance 'cluster
-		 :rbeams rbeams :lbeams lbeams :dots dots
-		 :notehead notehead :stem-direction stem-direction))
-
 (defun read-cluster-v3 (stream char n)
   (declare (ignore char n))
   (apply #'make-instance 'cluster (read-delimited-list #\] stream t)))
@@ -340,11 +335,6 @@
 (defmethod print-object :after ((s rest) stream)
   (with-slots (staff staff-pos) s
     (format stream ":staff ~W :staff-pos ~W " staff staff-pos)))
-
-(defun make-rest (rbeams lbeams dots notehead staff)
-  (make-instance 'rest
-		 :rbeams rbeams :lbeams lbeams :dots dots
-		 :notehead notehead :staff staff))
 
 (defun read-rest-v3 (stream char n)
   (declare (ignore char n))


Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.32 gsharp/gui.lisp:1.33
--- gsharp/gui.lisp:1.32	Mon Oct 31 21:38:49 2005
+++ gsharp/gui.lisp	Mon Oct 31 21:48:17 2005
@@ -564,11 +564,12 @@
 (defun insert-cluster ()
   (let* ((state (input-state *application-frame*))
 	 (cursor (cursor *application-frame*))
-	 (cluster (make-cluster (if (eq (notehead state) :filled) (rbeams state) 0)
-				(if (eq (notehead state) :filled) (lbeams state) 0)
-				(dots state)
-				(notehead state)
-				(stem-direction state))))
+	 (cluster (make-instance 'cluster
+		    :rbeams (if (eq (notehead state) :filled) (rbeams state) 0)
+		    :lbeams (if (eq (notehead state) :filled) (lbeams state) 0)
+		    :dots (dots state)
+		    :notehead (notehead state)
+		    :stem-direction (stem-direction state))))
     (insert-element cluster cursor)
     (forward-element cursor)
     cluster))
@@ -626,11 +627,12 @@
 (define-gsharp-command com-insert-rest ()
   (let* ((state (input-state *application-frame*))
 	 (cursor (cursor *application-frame*))
-	 (rest (make-rest (if (eq (notehead state) :filled) (rbeams state) 0)
-			  (if (eq (notehead state) :filled) (lbeams state) 0)
-			  (dots state)
-			  (notehead state)
-			  (car (staves (layer (cursor *application-frame*)))))))
+	 (rest (make-instance 'rest
+		 :rbeams (if (eq (notehead state) :filled) (rbeams state) 0)
+		 :lbeams (if (eq (notehead state) :filled) (lbeams state) 0)
+		 :dots (dots state)
+		 :notehead (notehead state)
+		 :staff (car (staves (layer (cursor *application-frame*)))))))
     (insert-element rest cursor)
     (forward-element cursor)
     rest))


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.18 gsharp/packages.lisp:1.19
--- gsharp/packages.lisp:1.18	Mon Oct 31 21:38:49 2005
+++ gsharp/packages.lisp	Mon Oct 31 21:48:17 2005
@@ -44,8 +44,8 @@
 	   #:note-less #:note-equal #:bar
 	   #:notehead #:rbeams #:lbeams #:dots #:element
 	   #:melody-element #:notes
-	   #:add-note #:find-note #:remove-note #:cluster #:make-cluster
-	   #:rest #:make-rest #:lyrics-element #:make-lyrics-element
+	   #:add-note #:find-note #:remove-note #:cluster
+	   #:rest #:lyrics-element #:make-lyrics-element
 	   #:slice #:elements
 	   #:nb-elements #:elementno #:add-element
 	   #:remove-element #:bar #:make-bar



From rstrandh at common-lisp.net  Mon Oct 31 21:16:05 2005
From: rstrandh at common-lisp.net (Robert Strandh)
Date: Mon, 31 Oct 2005 22:16:05 +0100 (CET)
Subject: [gsharp-cvs] CVS update: gsharp/buffer.lisp gsharp/gui.lisp
	gsharp/packages.lisp 
Message-ID: <20051031211605.15F02880DB@common-lisp.net>

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv15881

Modified Files:
	buffer.lisp gui.lisp packages.lisp 
Log Message:
Removed make-lyrics-element and make-empty-segment

Date: Mon Oct 31 22:16:04 2005
Author: rstrandh

Index: gsharp/buffer.lisp
diff -u gsharp/buffer.lisp:1.17 gsharp/buffer.lisp:1.18
--- gsharp/buffer.lisp:1.17	Mon Oct 31 21:48:17 2005
+++ gsharp/buffer.lisp	Mon Oct 31 22:16:03 2005
@@ -363,11 +363,6 @@
 	 (setf text (make-array length :adjustable t :element-type 'fixnum
 				:fill-pointer length :initial-contents text))))))
 
-(defun make-lyrics-element (rbeams lbeams dots notehead staff)
-  (make-instance 'lyrics-element
-     :rbeams rbeams :lbeams lbeams :dots dots
-     :notehead notehead :staff staff))
-
 (defmethod print-object :after ((elem lyrics-element) stream)
   (with-slots (staff text) elem
      (format stream ":staff ~W :text ~W " staff text)))
@@ -462,9 +457,6 @@
 (defclass melody-bar (bar)
   ((print-character :allocation :class :initform #\|)))
 
-(defun make-melody-bar ()
-  (make-instance 'melody-bar))
-
 (defun read-melody-bar-v3 (stream char n)
   (declare (ignore char n))
   (apply #'make-instance 'melody-bar (read-delimited-list #\] stream t)))
@@ -476,9 +468,6 @@
 (defclass lyrics-bar (bar)
   ((print-character :allocation :class :initform #\C)))
 
-(defun make-lyrics-bar ()
-  (make-instance 'lyrics-bar))
-
 (defun read-lyrics-bar-v3 (stream char n)
   (declare (ignore char n))
   (apply #'make-instance 'lyrics-bar (read-delimited-list #\] stream t)))
@@ -522,9 +511,6 @@
 (defmethod print-object :after ((s slice) stream)
   (format stream ":bars ~W " (bars s)))
 
-(defun make-empty-slice ()
-  (make-instance 'slice))
-
 (defun read-slice-v3 (stream char n)
   (declare (ignore char n))
   (apply #'make-instance 'slice (read-delimited-list #\] stream t)))
@@ -633,7 +619,7 @@
 
 (defmethod make-layer (name (initial-staff fiveline-staff))
   (flet ((make-initialized-slice ()
-	   (let ((slice (make-empty-slice)))
+	   (let ((slice (make-instance 'slice)))
 	     (add-bar (make-instance 'melody-bar) slice 0)
 	     slice)))
     (let* ((head (make-initialized-slice))
@@ -662,7 +648,7 @@
 
 (defmethod make-layer (name (initial-staff lyrics-staff))
   (flet ((make-initialized-slice ()
-	   (let ((slice (make-empty-slice)))
+	   (let ((slice (make-instance 'slice)))
 	     (add-bar (make-instance 'lyrics-bar) slice 0)
 	     slice)))
     (let* ((head (make-initialized-slice))
@@ -767,11 +753,8 @@
 (defmethod print-object :after ((s segment) stream)
   (format stream ":layers ~W " (layers s)))
 
-(defun make-empty-segment ()
-  (make-instance 'segment))
-
 (defun make-initialized-segment (staff)
-  (let ((segment (make-empty-segment)))
+  (let ((segment (make-instance 'segment)))
     (add-layer (make-layer "Default layer" staff) segment)
     segment))
 


Index: gsharp/gui.lisp
diff -u gsharp/gui.lisp:1.33 gsharp/gui.lisp:1.34
--- gsharp/gui.lisp:1.33	Mon Oct 31 21:48:17 2005
+++ gsharp/gui.lisp	Mon Oct 31 22:16:04 2005
@@ -1130,12 +1130,12 @@
 (defun insert-lyrics-element ()
   (let* ((state (input-state *application-frame*))
 	 (cursor (cursor *application-frame*))
-	 (element (make-lyrics-element
-		   (if (eq (notehead state) :filled) (rbeams state) 0)
-		   (if (eq (notehead state) :filled) (lbeams state) 0)
-		   (dots state)
-		   (notehead state)
-		   (car (staves (layer (cursor *application-frame*)))))))
+	 (element (make-instance 'lyrics-element
+		    :rbeams (if (eq (notehead state) :filled) (rbeams state) 0)
+		    :lbeams (if (eq (notehead state) :filled) (lbeams state) 0)
+		    :dots (dots state)
+		    :notehead (notehead state)
+		    :staff (car (staves (layer (cursor *application-frame*)))))))
     (insert-element element cursor)
     (forward-element cursor)
     element))


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.19 gsharp/packages.lisp:1.20
--- gsharp/packages.lisp:1.19	Mon Oct 31 21:48:17 2005
+++ gsharp/packages.lisp	Mon Oct 31 22:16:04 2005
@@ -45,7 +45,7 @@
 	   #:notehead #:rbeams #:lbeams #:dots #:element
 	   #:melody-element #:notes
 	   #:add-note #:find-note #:remove-note #:cluster
-	   #:rest #:lyrics-element #:make-lyrics-element
+	   #:rest #:lyrics-element
 	   #:slice #:elements
 	   #:nb-elements #:elementno #:add-element
 	   #:remove-element #:bar #:make-bar
@@ -58,7 +58,7 @@
 	   #:make-empty-buffer #:make-initialized-buffer 
 	   #:layers #:nb-layers #:layerno
 	   #:add-layer #:remove-layer #:segment
-	   #:make-empty-segment #:make-initialized-segment
+	   #:make-initialized-segment
 	   #:segments #:nb-segments #:segmentno #:staves
 	   #:find-staff #:add-segment #:remove-segment
 	   #:add-staff-before-staff #:add-staff-after-staff