[gsharp-cvs] CVS gsharp

crhodes crhodes at common-lisp.net
Thu Jun 7 09:26:05 UTC 2007


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 '(#\|))
 




More information about the Gsharp-cvs mailing list