Update of /project/gsharp/cvsroot/gsharp In directory clnet:/tmp/cvs-serv3367

Modified Files: gui.lisp modes.lisp Log Message: Somewhat hacky motion-by-layout commands (line- and page-based). These was by far the most annoying motion commands to be lacking when actually editing scores, in my opinion; C-a and C-e are absolutely wired into my fingers.

Future candidates for inclusion: motion by layer (ideally in a way that's related to the layout, so that in the common case where there is one layer per staff the Right Thing happens); motion by note-in-associated-layer (lyrics).

Also remove C-h binding for delete-current-element, and put Backspace in instead; this lets the ESA help bindings work.

--- /project/gsharp/cvsroot/gsharp/gui.lisp 2007/01/16 05:17:40 1.74 +++ /project/gsharp/cvsroot/gsharp/gui.lisp 2007/06/07 09:26:04 1.75 @@ -1016,6 +1016,98 @@

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; +;;; motion by layout (page or line) + +;;; support routines, needed because we're not cacheing the page +;;; breaks (other than in the buffer Obseq) nor the linebreaks (at +;;; all) +(defun position-containing-current-bar (sequence) + (let ((bar (bar (current-cursor)))) + (position-if (lambda (measure) (member bar (measure-bars measure))) + sequence))) +(defun get-page-lines (buffer page-measures) + (score-pane:with-staff-size 6 + (let* (;; all this untimely ripp'd from DRAW-BUFFER in + ;; drawing.lisp. Needs to be kept in sync, otherwise the + ;; layout for motion will be different from the layout on + ;; the screen... + (staves (staves buffer)) + (timesig-offset (gsharp-drawing::compute-timesig-offset staves)) + (method (let ((old-method (buffer-cost-method buffer))) + (make-measure-cost-method (min-width old-method) + (spacing-style old-method) + (- (line-width old-method) timesig-offset) + (lines-per-page old-method)))) + (systems-per-page (max 1 (floor 12 (length staves))))) + (gsharp-drawing::layout-page page-measures systems-per-page method)))) + +;;; FIXME: these routines should implement numeric-argument handling +(define-gsharp-command (com-forward-page :name t) + () + (let ((cursor (current-cursor))) + (gsharp-measure::new-map-over-obseq-subsequences + (lambda (page-measures) + (let ((position (position-containing-current-bar page-measures))) + (when position + (loop repeat (- (length page-measures) position) + if (last-bar-p cursor) + do (go-to-end-of-bar cursor) (return-from com-forward-page) + else do (forward-bar cursor) + finally (return-from com-forward-page))))) + (current-buffer)))) +(define-gsharp-command (com-backward-page :name t) + () + (let ((cursor (current-cursor))) + (gsharp-measure::new-map-over-obseq-subsequences + (let ((last 0)) + (lambda (page-measures) + (let ((position (position-containing-current-bar page-measures))) + (when position + (loop repeat (+ position last) + do (backward-bar cursor) + finally (progn + (go-to-beginning-of-bar cursor) + (return-from com-backward-page))))) + (setf last (length page-measures)))) + (current-buffer)))) + +(define-gsharp-command (com-end-of-line :name t) + () + (let ((buffer (current-buffer)) + (cursor (current-cursor))) + (gsharp-measure::new-map-over-obseq-subsequences + (lambda (page-measures) + (when (position-containing-current-bar page-measures) + (let ((lines (get-page-lines buffer page-measures))) + (dolist (line lines) + (let ((position (position-containing-current-bar line))) + (when position + (loop repeat (- (length line) position 1) + do (forward-bar cursor) + finally (progn + (go-to-end-of-bar cursor) + (return-from com-end-of-line))))))))) + buffer))) +(define-gsharp-command (com-beginning-of-line :name t) + () + (let ((buffer (current-buffer)) + (cursor (current-cursor))) + (gsharp-measure::new-map-over-obseq-subsequences + (lambda (page-measures) + (when (position-containing-current-bar page-measures) + (let ((lines (get-page-lines buffer page-measures))) + (dolist (line lines) + (let ((position (position-containing-current-bar line))) + (when position + (loop repeat position + do (backward-bar cursor) + finally (progn + (go-to-beginning-of-bar cursor) + (return-from com-beginning-of-line))))))))) + buffer))) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; ;;; delete commands

(defun go-to-beginning-of-bar (cursor) --- /project/gsharp/cvsroot/gsharp/modes.lisp 2007/01/16 05:11:09 1.21 +++ /project/gsharp/cvsroot/gsharp/modes.lisp 2007/06/07 09:26:05 1.22 @@ -8,7 +8,14 @@ (set-key `(com-forward-measure ,*numeric-argument-marker*) 'global-gsharp-table '((#\f :control :meta))) (set-key `(com-backward-measure ,*numeric-argument-marker*) 'global-gsharp-table '((#\b :control :meta))) (set-key `(com-delete-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\d :control))) -(set-key `(com-erase-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\h :control))) +(set-key `(com-delete-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\Rubout))) +(set-key `(com-erase-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\Backspace))) + +;;; FIXME: implement numeric arg handling +(set-key 'com-forward-page 'global-gsharp-table '((#\x :control) #])) +(set-key 'com-backward-page 'global-gsharp-table '((#\x :control) #[)) +(set-key 'com-end-of-line 'global-gsharp-table '((#\e :control))) +(set-key 'com-beginning-of-line 'global-gsharp-table '((#\a :control)))

(set-key 'com-insert-barline 'global-gsharp-table '(#|))