gsharp-cvs October 2005

gsharp-cvs@common-lisp.net

2 participants
23 discussions

[gsharp-cvs] CVS update: gsharp/gui.lisp gsharp/packages.lisp
by rstrandh＠common-lisp.net 31 Oct '05

31 Oct '05

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)

1 0

[gsharp-cvs] CVS update: gsharp/play.lisp gsharp/buffer.lisp gsharp/drawing.lisp gsharp/gui.lisp gsharp/packages.lisp gsharp/system.lisp
by rstrandh＠common-lisp.net 31 Oct '05

31 Oct '05

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")

1 0

[gsharp-cvs] CVS update: gsharp/Doc/buffer.tex
by rstrandh＠common-lisp.net 31 Oct '05

31 Oct '05

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))}

1 0

[gsharp-cvs] CVS update: gsharp/esa.lisp
by crhodes＠common-lisp.net 28 Oct '05

28 Oct '05

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))))))

1 0

[gsharp-cvs] CVS update: gsharp/Flexichain/Doc/Makefile gsharp/Flexichain/Doc/tex-dependencies
by rstrandh＠common-lisp.net 28 Oct '05

28 Oct '05

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

1 0

[gsharp-cvs] CVS update: gsharp/modes.lisp
by crhodes＠common-lisp.net 28 Oct '05

28 Oct '05

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)

1 0

[gsharp-cvs] CVS update: gsharp/gui.lisp
by crhodes＠common-lisp.net 28 Oct '05

28 Oct '05

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))

1 0

[gsharp-cvs] CVS update: gsharp/score-pane.lisp
by crhodes＠common-lisp.net 28 Oct '05

28 Oct '05

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)

1 0

[gsharp-cvs] CVS update: gsharp/gui.lisp
by crhodes＠common-lisp.net 28 Oct '05

28 Oct '05

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")))

1 0

[gsharp-cvs] CVS update: gsharp/esa.lisp
by crhodes＠common-lisp.net 28 Oct '05

28 Oct '05

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))

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

gsharp-cvs October 2005