gsharp-cvs

gsharp-cvs@common-lisp.net

396 discussions

[gsharp-cvs] CVS update: gsharp/gui.lisp
by Robert Strandh 19 Feb '04

19 Feb '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv22319 Modified Files: gui.lisp Log Message: Forgot to save buffer before committing. Date: Thu Feb 19 03:50:27 2004 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.5 gsharp/gui.lisp:1.6 --- gsharp/gui.lisp:1.5 Thu Feb 19 01:39:41 2004 +++ gsharp/gui.lisp Thu Feb 19 03:50:27 2004 @@ -1063,7 +1063,7 @@ (define-gsharp-command com-end-kbd-macro () (message "keyboad macro defined~%") (setf *kbd-macro-recording-p* nil - *kbd-macro-keys* (nreverse *kbd-macro-keys*))) + *kbd-macro-keys* (nreverse (cddr *kbd-macro-keys*)))) (define-gsharp-command com-call-last-kbd-macro () (loop with commands = *global-command-table*

1 0

[gsharp-cvs] CVS update: gsharp/Doc/commands.tex
by Robert Strandh 19 Feb '04

19 Feb '04

Update of /project/gsharp/cvsroot/gsharp/Doc In directory common-lisp.net:/tmp/cvs-serv9894 Modified Files: commands.tex Log Message: Added keyboard macros to reference manual. Date: Thu Feb 19 01:48:09 2004 Author: rstrandh Index: gsharp/Doc/commands.tex diff -u gsharp/Doc/commands.tex:1.1.1.1 gsharp/Doc/commands.tex:1.2 --- gsharp/Doc/commands.tex:1.1.1.1 Mon Feb 16 10:46:23 2004 +++ gsharp/Doc/commands.tex Thu Feb 19 01:48:08 2004 @@ -174,3 +174,17 @@ & & (currently wipes the current buffer)\\ \hline \end{tabular} + +\section{Keyboard macros} + +\begin{tabular}{|l|l|l|} +\hline +Key & Command name & Description\\ +\hline +C-x ( & Start Keyboard Macro & Start recording keystrokes \\ + & & for later execution \\ +C-x ) & End Keyboard Macro & Stop recording keystrokes \\ +C-x e & Call Last Keyboard Macro & Execute recorded keystrokes \\ +\hline +\end{tabular} +

1 0

[gsharp-cvs] CVS update: gsharp/gui.lisp
by Robert Strandh 19 Feb '04

19 Feb '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv24530 Modified Files: gui.lisp Log Message: Added Emacs-style keboard macro facility. Date: Thu Feb 19 01:39:41 2004 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.4 gsharp/gui.lisp:1.5 --- gsharp/gui.lisp:1.4 Wed Feb 18 13:16:16 2004 +++ gsharp/gui.lisp Thu Feb 19 01:39:41 2004 @@ -11,6 +11,7 @@ (defparameter *x-command-table* (make-hash-table :test #'equal)) (defparameter *i-command-table* (make-hash-table :test #'equal)) (defparameter *ix-command-table* (make-hash-table :test #'equal)) +(defparameter *c-x-command-table* (make-hash-table :test #'equal)) (defparameter *commands* *global-command-table*) (defun add-command (gesture command table) @@ -64,6 +65,7 @@ (add-command '(#\n :meta) 'com-next-layer *global-command-table*) (add-command '(#\x) *x-command-table* *global-command-table*) (add-command '(#\i) *i-command-table* *global-command-table*) +(add-command '(#\x :control) *c-x-command-table* *global-command-table*) ;;; i command table (add-command '(#\.) 'com-istate-more-dots *i-command-table*) @@ -83,6 +85,13 @@ (add-command '(#\[) 'com-fewer-lbeams *x-command-table*) (add-command '(#\]) 'com-fewer-rbeams *x-command-table*) +;;; c-x-command-table +(add-command '(#$ :shift) 'com-start-kbd-macro *c-x-command-table*) +(add-command '(#\() 'com-start-kbd-macro *c-x-command-table*) +(add-command '(#$ :shift) 'com-end-kbd-macro *c-x-command-table*) +(add-command '(#\)) 'com-end-kbd-macro *c-x-command-table*) +(add-command '(#\e) 'com-call-last-kbd-macro *c-x-command-table*) + (defmethod redisplay-gsharp-panes (frame &key force-p) (loop for pane in (frame-current-panes frame) do (when (typep pane 'score-pane) @@ -90,18 +99,24 @@ (defvar *gsharp-frame*) +(defparameter *kbd-macro-recording-p* nil) +(defparameter *kbd-macro-keys* '()) + (defmethod dispatch-event :around ((pane score-pane) (event key-press-event)) (when (keyboard-event-character event) (let* ((key (list (keyboard-event-character event) (event-modifier-state event))) (command (gethash key *commands*))) + (when *kbd-macro-recording-p* (push key *kbd-macro-keys*)) (cond ((hash-table-p command) (setf *commands* command)) ((fboundp command) (handler-case (funcall command) (gsharp-condition (condition) (format *error-output* "~a~%" condition))) (setf *commands* *global-command-table*)) (t (format *error-output* "no command for ~a~%" key) - (setf *commands* *global-command-table*))) + (setf *commands* *global-command-table*) + (when *kbd-macro-recording-p* (setf *kbd-macro-keys* '() + *kbd-macro-recording-p* nil)))) (redisplay-gsharp-panes *gsharp-frame* :force-p t)))) (define-application-frame gsharp () @@ -1038,3 +1053,24 @@ ((eq (aref keysig 4) :natural) (setf (aref keysig 4) :flat)) ((eq (aref keysig 0) :natural) (setf (aref keysig 0) :flat)) ((eq (aref keysig 3) :natural) (setf (aref keysig 3) :flat))))) + +;;; macro processing +(define-gsharp-command com-start-kbd-macro () + (message "defining keyboad macro~%") + (setf *kbd-macro-recording-p* t + *kbd-macro-keys* '())) + +(define-gsharp-command com-end-kbd-macro () + (message "keyboad macro defined~%") + (setf *kbd-macro-recording-p* nil + *kbd-macro-keys* (nreverse *kbd-macro-keys*))) + +(define-gsharp-command com-call-last-kbd-macro () + (loop with commands = *global-command-table* + for key in *kbd-macro-keys* do + (let ((command (gethash key commands))) + (cond ((hash-table-p command) (setf commands command)) + ((fboundp command) + (handler-case (funcall command) + (gsharp-condition (condition) (format *error-output* "~a~%" condition)))) + (t (message "no command for ~a~%" key))))))

1 0

[gsharp-cvs] CVS update: gsharp/sdl.lisp
by Robert Strandh 19 Feb '04

19 Feb '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv21441 Modified Files: sdl.lisp Log Message: Fixed the :relative problem according to Andras Simon. Date: Thu Feb 19 00:57:22 2004 Author: rstrandh Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.2 gsharp/sdl.lisp:1.3 --- gsharp/sdl.lisp:1.2 Mon Feb 16 13:50:20 2004 +++ gsharp/sdl.lisp Thu Feb 19 00:57:22 2004 @@ -1,7 +1,7 @@ (in-package :sdl) (defvar *fonts-directory* - (merge-pathnames (make-pathname :directory '(relative "Fonts")) + (merge-pathnames (make-pathname :directory '(:relative "Fonts")) (make-pathname :directory (pathname-directory *load-truename*)))) (defgeneric glyph (font glyph-no))

1 0

[gsharp-cvs] CVS update: gsharp/gui.lisp
by Christophe Rhodes 18 Feb '04

18 Feb '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv14720 Modified Files: gui.lisp Log Message: Workaround the :shift problem with #\# commands: add an unshifted variant. Date: Wed Feb 18 13:16:16 2004 Author: crhodes Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.3 gsharp/gui.lisp:1.4 --- gsharp/gui.lisp:1.3 Mon Feb 16 13:43:54 2004 +++ gsharp/gui.lisp Wed Feb 18 13:16:16 2004 @@ -50,8 +50,10 @@ (add-command '(#\.) 'com-more-dots *global-command-table*) (add-command '(#\[) 'com-more-lbeams *global-command-table*) (add-command '(#\]) 'com-more-rbeams *global-command-table*) +(add-command '(#\#) 'com-sharper *global-command-table*) (add-command '(#\# :shift) 'com-sharper *global-command-table*) (add-command '(#\@ :shift) 'com-flatter *global-command-table*) +(add-command '(#\# :meta) 'com-more-sharps *global-command-table*) (add-command '(#\# :meta :shift) 'com-more-sharps *global-command-table*) (add-command '(#\@ :meta :shift) 'com-more-flats *global-command-table*) (add-command '(#\u :meta) 'com-up *global-command-table*)

1 0

[gsharp-cvs] CVS update: gsharp/midi.lisp
by Christophe Rhodes 18 Feb '04

18 Feb '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv13115 Modified Files: midi.lisp Log Message: Fix for MIDI files already existing: make WITH-MIDI-INPUT/OUTPUT slightly more flexible, and specify :if-exists :supersede Date: Wed Feb 18 13:15:46 2004 Author: crhodes Index: gsharp/midi.lisp diff -u gsharp/midi.lisp:1.1.1.1 gsharp/midi.lisp:1.2 --- gsharp/midi.lisp:1.1.1.1 Mon Feb 16 10:46:18 2004 +++ gsharp/midi.lisp Wed Feb 18 13:15:46 2004 @@ -105,16 +105,18 @@ (write-fixed-length-quantity (ash quantity -8) (1- nb-bytes)) (write-bytes (logand quantity #xff)))) -(defmacro with-midi-input (filename &body body) - "execute body with *midi-input* assigned to a stream from filename" - `(with-open-file (*midi-input* ,filename - :direction :input :element-type '(unsigned-byte 8)) +(defmacro with-midi-input ((pathname &rest open-args &key &allow-other-keys) &body body) + "execute body with *midi-input* assigned to a stream from pathname" + `(with-open-file (*midi-input* ,pathname + :direction :input :element-type '(unsigned-byte 8) + ,@open-args) ,@body)) -(defmacro with-midi-output (filename &body body) - "execute body with *midi-output* assigned to a stream from filename" - `(with-open-file (*midi-output* ,filename - :direction :output :element-type '(unsigned-byte 8)) +(defmacro with-midi-output ((pathname &rest open-args &key &allow-other-keys) &body body) + "execute body with *midi-output* assigned to a stream from pathname" + `(with-open-file (*midi-output* ,pathname + :direction :output :element-type '(unsigned-byte 8) + ,@open-args) ,@body)) (defun read-variable-length-quantity () @@ -225,7 +227,7 @@ (defun read-midi-file (filename) "read an entire Midifile from the file with name given as argument" (setf *time* 0) - (with-midi-input filename + (with-midi-input (filename) (let ((type (read-fixed-length-quantity 4)) (length (read-fixed-length-quantity 4)) (format (read-fixed-length-quantity 2)) @@ -241,7 +243,7 @@ collect (read-track)))))) (defun write-midi-file (midifile filename) - (with-midi-output filename + (with-midi-output (filename :if-exists :supersede) (write-fixed-length-quantity +header-mthd+ 4) (write-fixed-length-quantity +header-mthd-length+ 4) (with-slots (format division tracks) midifile

1 0

[gsharp-cvs] CVS update: CVSROOT/config
by root 17 Feb '04

17 Feb '04

Update of /project/gsharp/cvsroot/CVSROOT In directory common-lisp.net:/tmp/CVSROOT Modified Files: config Log Message: changing lockdir Date: Tue Feb 17 08:01:02 2004 Author: root Index: CVSROOT/config diff -u CVSROOT/config:1.1 CVSROOT/config:1.2 --- CVSROOT/config:1.1 Wed Feb 11 10:22:54 2004 +++ CVSROOT/config Tue Feb 17 08:01:01 2004 @@ -2,7 +2,7 @@ #SystemAuth=no # Put CVS lock files in this directory rather than directly in the repository. -#LockDir=/var/lock/cvs +LockDir=/var/lock/gsharp # Set `TopLevelAdmin' to `yes' to create a CVS directory at the top # level of the new working directory when using the `cvs checkout'

1 0

[gsharp-cvs] CVS update: gsharp/system.lisp
by Christophe Rhodes 16 Feb '04

16 Feb '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv7473 Modified Files: system.lisp Log Message: Make GSHARP-DEFSYSTEM define systems for both mk-defsystem and asdf if both are present in the image in question Date: Mon Feb 16 13:50:59 2004 Author: crhodes Index: gsharp/system.lisp diff -u gsharp/system.lisp:1.2 gsharp/system.lisp:1.3 --- gsharp/system.lisp:1.2 Mon Feb 16 11:08:00 2004 +++ gsharp/system.lisp Mon Feb 16 13:50:59 2004 @@ -3,22 +3,22 @@ (defparameter *gsharp-directory* (directory-namestring *load-truename*)) (defmacro gsharp-defsystem ((module &key depends-on) &rest components) - `(defsystem ,module - :source-pathname *gsharp-directory* - ,@(and depends-on `(:depends-on ,depends-on)) - :components (:serial ,@components))) - -#+asdf -(defmacro gsharp-defsystem ((module &key depends-on) &rest components) - `(asdf:defsystem ,module - ,@(and depends-on `(:depends-on ,depends-on)) - :serial t - :components (,@(loop for c in components - for p = (merge-pathnames - (parse-namestring c) - (make-pathname :type "lisp" - :defaults *gsharp-directory*)) - collect `(:file ,(pathname-name p) :pathname ,p))))) + `(progn + #+mk-defsystem + (mk:defsystem ,module + :source-pathname *gsharp-directory* + ,@(and depends-on `(:depends-on ,depends-on)) + :components (:serial ,@components)) + #+asdf + (asdf:defsystem ,module + ,@(and depends-on `(:depends-on ,depends-on)) + :serial t + :components (,@(loop for c in components + for p = (merge-pathnames + (parse-namestring c) + (make-pathname :type "lisp" + :defaults *gsharp-directory*)) + collect `(:file ,(pathname-name p) :pathname ,p)))))) (gsharp-defsystem (:gsharp) "packages"

1 0

[gsharp-cvs] CVS update: gsharp/sdl.lisp
by Christophe Rhodes 16 Feb '04

16 Feb '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv11405 Modified Files: sdl.lisp Log Message: add *FONTS-DIRECTORY* to allow running GSharp when not in the gsharp directory; essentially, we address the path relative to the path of sdl.lisp or sdl.fasl (note: may break if this is subjected to Debian's common-lisp-controller) One remaining LOOP BY -1 that slipped through the net Date: Mon Feb 16 13:50:20 2004 Author: crhodes Index: gsharp/sdl.lisp diff -u gsharp/sdl.lisp:1.1.1.1 gsharp/sdl.lisp:1.2 --- gsharp/sdl.lisp:1.1.1.1 Mon Feb 16 10:46:21 2004 +++ gsharp/sdl.lisp Mon Feb 16 13:50:20 2004 @@ -1,5 +1,9 @@ (in-package :sdl) +(defvar *fonts-directory* + (merge-pathnames (make-pathname :directory '(relative "Fonts")) + (make-pathname :directory (pathname-directory *load-truename*)))) + (defgeneric glyph (font glyph-no)) (defgeneric glyph-offsets (font glyph-no)) (defgeneric staff-line-distance (font)) @@ -113,7 +117,7 @@ :element-type '(unsigned-byte 8) :initial-element 16)) (loop for r from 0 below (car (array-dimensions matrix)) - for y from (gf-char-max-n gf-char) by -1 do + for y downfrom (gf-char-max-n gf-char) by 1 do (loop for c from 0 below (cadr (array-dimensions matrix)) for x from (gf-char-min-m gf-char) do (decf (aref pixmap @@ -159,7 +163,9 @@ (- notehead-right-x-offset notehead-left-x-offset))) (defun load-font (staff-line-distance) - (let* ((gf-font (parse-gf-file (format nil "Fonts/sdl~a.gf" staff-line-distance))) + (let* ((gf-font (parse-gf-file (merge-pathnames + (format nil "sdl~a.gf" staff-line-distance) + *fonts-directory*))) (maxchar (reduce #'max (gf-font-chars gf-font) :key #'gf-char-no)) (glyphs (make-array (list (1+ maxchar)) :initial-element nil))) (loop for char in (gf-font-chars gf-font) do

1 0

[gsharp-cvs] CVS update: gsharp/gui.lisp
by Christophe Rhodes 16 Feb '04

16 Feb '04

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv4973 Modified Files: gui.lisp Log Message: Make the sbcl version of run-program search through $PATH for timidity Date: Mon Feb 16 13:43:55 2004 Author: crhodes Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.2 gsharp/gui.lisp:1.3 --- gsharp/gui.lisp:1.2 Mon Feb 16 11:08:00 2004 +++ gsharp/gui.lisp Mon Feb 16 13:43:54 2004 @@ -567,7 +567,7 @@ #+cmu (ext:run-program "timidity" '("test.mid")) #+sbcl - (sb-ext:run-program "timidity" '("test.mid")) + (sb-ext:run-program "timidity" '("test.mid") :search t) #-(or cmu sbcl) (error "write compatibility layer for RUN-PROGRAM"))) @@ -583,7 +583,7 @@ #+cmu (ext:run-program "timidity" '("test.mid")) #+sbcl - (sb-ext:run-program "timidity" '("test.mid")) + (sb-ext:run-program "timidity" '("test.mid") :search t) #-(or cmu sbcl) (error "write compatibility layer for RUN-PROGRAM")))

1 0

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

gsharp-cvs