Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv3313 Modified Files: buffer.lisp gui.lisp packages.lisp Log Message: Patch to allow the current note to be deleted. (thanks to Robert J. Macomber) Date: Sun Nov 20 20:17:22 2005 Author: rstrandh Index: gsharp/buffer.lisp diff -u gsharp/buffer.lisp:1.26 gsharp/buffer.lisp:1.27 --- gsharp/buffer.lisp:1.26 Wed Nov 16 02:27:34 2005 +++ gsharp/buffer.lisp Sun Nov 20 20:17:22 2005 @@ -352,6 +352,24 @@ (setf notes (delete note notes :test #'eq))) (setf cluster nil))) +(defun lower-bound (bound list &key (test #'<)) + "Return the `largest' element in the sorted list LIST such that +\(TEST element BOUND) is true." + (let ((last nil)) + (dolist (item list) + (unless (funcall test item bound) + (return-from lower-bound last)) + (setf last item)) + last)) + +(defmethod cluster-lower-bound ((cluster cluster) (bound note)) + (with-slots (notes) cluster + (lower-bound bound notes :test #'note-less))) + +(defmethod cluster-upper-bound ((cluster cluster) (bound note)) + (with-slots (notes) cluster + (lower-bound bound (reverse notes) :test (complement #'note-less)))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; Rest Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.43 gsharp/gui.lisp:1.44 --- gsharp/gui.lisp:1.43 Mon Nov 14 21:26:14 2005 +++ gsharp/gui.lisp Sun Nov 20 20:17:22 2005 @@ -812,6 +812,19 @@ (add-note cluster new-note) (setf *current-note* new-note))) +(define-gsharp-command com-remove-current-note () + (let ((cluster (cur-cluster)) + (note (cur-note))) + (when note + (remove-note note) + ;; try to set current-note to the highest note lower than the + ;; removed note. If that fails, to the lowest note higher than + ;; it. + (setf *current-note* (or (cluster-lower-bound cluster note) + (cluster-upper-bound cluster note))) + (unless *current-note* + (com-erase-element))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; ;;; motion by element Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.28 gsharp/packages.lisp:1.29 --- gsharp/packages.lisp:1.28 Sat Nov 19 06:16:28 2005 +++ gsharp/packages.lisp Sun Nov 20 20:17:22 2005 @@ -45,6 +45,7 @@ #:notehead #:rbeams #:lbeams #:dots #:element #:melody-element #:notes #:add-note #:find-note #:remove-note + #:cluster-upper-bound #:cluster-lower-bound #:cluster #:make-cluster #:rest #:make-rest #:lyrics-element #:make-lyrics-element