modes.lisp

   1 (in-package :gsharp)
   2
   3 (define-command-table global-gsharp-table
   4     :inherit-from (global-esa-table esa-io-table keyboard-macro-table help-table))
   5
   6 (set-key `(com-forward-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\f :control)))
   7 (set-key `(com-backward-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\b :control)))
   8 (set-key `(com-forward-measure ,*numeric-argument-marker*) 'global-gsharp-table '((#\f :control :meta)))
   9 (set-key `(com-backward-measure ,*numeric-argument-marker*) 'global-gsharp-table '((#\b :control :meta)))
  10 (set-key `(com-delete-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\d :control)))
  11 (set-key `(com-delete-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\Rubout)))
  12 (set-key `(com-erase-element ,*numeric-argument-marker*) 'global-gsharp-table '((#\Backspace)))
  13
  14 (set-key `(com-switch-to-view ,*unsupplied-argument-marker*) 'global-gsharp-table '((#\x :control) #\b))
  15 (set-key `(com-kill-view ,*unsupplied-argument-marker*) 'global-gsharp-table '((#\x :control) #\k))
  16
  17 ;;; FIXME: implement numeric arg handling
  18 (set-key 'com-forward-page 'global-gsharp-table '((#\x :control) #\]))
  19 (set-key 'com-backward-page 'global-gsharp-table '((#\x :control) #\[))
  20 (set-key 'com-end-of-line 'global-gsharp-table '((#\e :control)))
  21 (set-key 'com-beginning-of-line 'global-gsharp-table '((#\a :control)))
  22
  23 ;;; FIXME: implement numeric arg handling
  24 (set-key 'com-previous-staff 'global-gsharp-table '((:up :control)))
  25 (set-key 'com-next-staff 'global-gsharp-table '((:down :control)))
  26
  27 (set-key 'com-insert-barline 'global-gsharp-table '(#\|))
  28
  29 (set-key 'com-end-of-score 'global-gsharp-table '((#\> :meta)))
  30 (set-key 'com-beginning-of-score 'global-gsharp-table '((#\< :meta)))
  31
  32 ;;; FIXME where are the corresponding commands?
  33 (set-key 'com-left 'global-gsharp-table '((#\l :meta)))
  34 (set-key 'com-right 'global-gsharp-table '((#\r :meta)))
  35
  36 ;; Post MS file-io keystrokes
  37 (set-key 'com-load-score-file 'global-gsharp-table '((#\o :meta)))
  38 (set-key 'com-save-score-file-as 'global-gsharp-table '((#\S :meta)))
  39 (set-key 'com-save-buffer 'global-gsharp-table '((#\s :meta)))
  40
  41
  42 (set-key 'com-istate-more-dots 'global-gsharp-table '((#\i) (#\.)))
  43 (set-key 'com-istate-more-lbeams 'global-gsharp-table '((#\i) (#\[)))
  44 (set-key 'com-istate-more-rbeams 'global-gsharp-table '((#\i) (#\])))
  45 (set-key 'com-istate-rotate-notehead 'global-gsharp-table '((#\i) (#\h)))
  46 (set-key 'com-istate-rotate-notehead-downwards 'global-gsharp-table '((#\i) (#\g)))
  47 (set-key 'com-istate-rotate-stem-direction 'global-gsharp-table '((#\i) (#\s)))
  48 (set-key 'com-istate-fewer-dots 'global-gsharp-table '((#\i) (#\x) (#\.)))
  49 (set-key 'com-istate-fewer-lbeams 'global-gsharp-table '((#\i) (#\x) (#\[)))
  50 (set-key 'com-istate-fewer-rbeams 'global-gsharp-table '((#\i) (#\x) (#\])))
  51
  52 (set-key 'com-zoom-in 'global-gsharp-table '(#\+))
  53 (set-key 'com-zoom-out 'global-gsharp-table '(#\-))
  54
  55 (set-key `(com-eval-expression ,*unsupplied-argument-marker*)
  56          'global-gsharp-table '((#\: :meta)))
  57
  58 ;;; the melody table contains commands that are specific to the
  59 ;;; melody layer
  60
  61 (define-command-table melody-table)
  62
  63 (set-key 'com-lower 'melody-table '(#\L))
  64 (set-key 'com-higher 'melody-table '(#\H))
  65 (set-key 'com-insert-note-a 'melody-table '(#\a))
  66 (set-key 'com-insert-note-b 'melody-table '(#\b))
  67 (set-key 'com-insert-note-c 'melody-table '(#\c))
  68 (set-key 'com-insert-note-d 'melody-table '(#\d))
  69 (set-key 'com-insert-note-e 'melody-table '(#\e))
  70 (set-key 'com-insert-note-f 'melody-table '(#\f))
  71 (set-key 'com-insert-note-g 'melody-table '(#\g))
  72 (set-key 'com-insert-rest 'melody-table '((#\,)))
  73 (set-key 'com-insert-empty-cluster 'melody-table '((#\Space)))
  74 (set-key 'com-insert-keysig 'melody-table '(#\K))
  75
  76 (set-key 'com-more-sharps 'melody-table '((#\# :meta)))
  77 (set-key 'com-more-flats 'melody-table '((#\@ :meta)))
  78
  79 ;;; the rhythmic table contains command that are specific
  80 ;;; to rhythmic elements
  81 (define-command-table rhythmic-table)
  82
  83 (set-key 'com-more-dots 'rhythmic-table '((#\.)))
  84 (set-key 'com-more-lbeams 'rhythmic-table '((#\[)))
  85 (set-key 'com-more-rbeams 'rhythmic-table '((#\])))
  86 (set-key 'com-fewer-dots 'rhythmic-table '((#\x) (#\.)))
  87 (set-key 'com-fewer-lbeams 'rhythmic-table '((#\x) (#\[)))
  88 (set-key 'com-fewer-rbeams 'rhythmic-table '((#\x) (#\])))
  89 (set-key 'com-rotate-notehead 'rhythmic-table '((#\h :meta)))
  90 (set-key 'com-rotate-notehead 'rhythmic-table '((#\r :control))) ; why this one too?
  91 (set-key 'com-up 'rhythmic-table '((#\u :meta)))
  92 (set-key 'com-down 'rhythmic-table '((#\d :meta)))
  93
  94 ;;; the cluster table contains commands that are specific to
  95 ;;; clusters
  96
  97 (define-command-table cluster-table
  98     :inherit-from (rhythmic-table))
  99
 100 (set-key 'com-sharper 'cluster-table '((#\#)))
 101 (set-key 'com-flatter 'cluster-table '(#\@))
 102 (set-key 'com-microsharper 'cluster-table '((#\# :control)))
 103 (set-key 'com-microsharper 'cluster-table '((#\# :control)))
 104 (set-key 'com-microflatter 'cluster-table '((#\@ :control)))
 105 (set-key 'com-microflatter 'cluster-table '((#\@ :control)))
 106 (set-key 'com-add-note-c 'cluster-table '(#\C))
 107 (set-key 'com-add-note-d 'cluster-table '(#\D))
 108 (set-key 'com-add-note-e 'cluster-table '(#\E))
 109 (set-key 'com-add-note-f 'cluster-table '(#\F))
 110 (set-key 'com-add-note-g 'cluster-table '(#\G))
 111 (set-key 'com-add-note-a 'cluster-table '(#\A))
 112 (set-key 'com-add-note-b 'cluster-table '(#\B))
 113 (set-key 'com-tie-note-left 'cluster-table '((#\{)))
 114 (set-key 'com-tie-note-right 'cluster-table '((#\})))
 115 (set-key 'com-untie-note-left 'cluster-table '((#\x) (#\{)))
 116 (set-key 'com-untie-note-right 'cluster-table '((#\x) (#\})))
 117 (set-key 'com-rotate-stem-direction 'cluster-table '((#\s :meta)))
 118 (set-key 'com-toggle-staccato 'cluster-table '(#\s))
 119 (set-key 'com-toggle-tenuto 'cluster-table '(#\t))
 120 (set-key 'com-current-increment 'cluster-table '((#\p)))
 121 (set-key 'com-current-decrement 'cluster-table '((#\n)))
 122 (set-key 'com-octave-up 'cluster-table '((#\U :meta)))
 123 (set-key 'com-octave-down 'cluster-table '((#\D :meta)))
 124
 125 ;;; lyrics mode table
 126
 127 (define-command-table lyrics-table
 128     :inherit-from (rhythmic-table))
 129
 130 (set-key (lambda () (erase-char (cur-element))) 'lyrics-table '((#\h :control)))
 131 (set-key `(com-erase-element *numeric-argument-marker*) 'lyrics-table '((#\h :meta)))
 132 (set-key 'insert-lyrics-element 'lyrics-table '((#\Space :control)))
 133
 134
 135 (defun make-insert-fun (code)
 136   (lambda () (append-char (cur-element) code)))
 137
 138 (loop for c in '(#\A #\B #\C #\D #\E #\F #\G #\H #\I #\J #\K #\L #\M
 139                  #\N #\O #\P #\Q #\R #\S #\T #\U #\V #\W #\X #\Y #\Z)
 140       for i from 65
 141       do (set-key (make-insert-fun i) 'lyrics-table `((,c))))
 142
 143 (loop for c in '(#\a #\b #\c #\d #\e #\f #\g #\h #\i #\j #\k #\l #\m
 144                  #\n #\o #\p #\q #\r #\s #\t #\u #\v #\w #\x #\y #\z)
 145       for i from 97
 146       do (set-key (make-insert-fun i) 'lyrics-table`((,c))))
 147
 148 ;;; try some latin prefix mode for national characters
 149 (set-key (make-insert-fun 192) 'lyrics-table '((:dead--grave) (#\A)))
 150 (set-key (make-insert-fun 193) 'lyrics-table '((:dead--acute) (#\A)))
 151 (set-key (make-insert-fun 194) 'lyrics-table '((:dead--circumflex) (#\A)))
 152 (set-key (make-insert-fun 195) 'lyrics-table '((:dead--tilde) (#\A)))
 153 (set-key (make-insert-fun 196) 'lyrics-table '((:dead--diaeresis) (#\A)))
 154 (set-key (make-insert-fun 197) 'lyrics-table '((:dead-above-ring) (#\A)))
 155 (set-key (make-insert-fun 198) 'lyrics-table '((:dead-above-ring) (#\E)))
 156 (set-key (make-insert-fun 199) 'lyrics-table '((:dead-above-ring) (#\C)))
 157 (set-key (make-insert-fun 200) 'lyrics-table '((:dead--grave) (#\E)))
 158 (set-key (make-insert-fun 201) 'lyrics-table '((:dead--acute) (#\E)))
 159 (set-key (make-insert-fun 202) 'lyrics-table '((:dead--circumflex) (#\E)))
 160 (set-key (make-insert-fun 203) 'lyrics-table '((:dead--diaeresis) (#\E)))
 161 (set-key (make-insert-fun 204) 'lyrics-table '((:dead--grave) (#\I)))
 162 (set-key (make-insert-fun 205) 'lyrics-table '((:dead--acute) (#\I)))
 163 (set-key (make-insert-fun 206) 'lyrics-table '((:dead--circumflex) (#\I)))
 164 (set-key (make-insert-fun 207) 'lyrics-table '((:dead--diaeresis) (#\I)))
 165 (set-key (make-insert-fun 208) 'lyrics-table '((:dead-above-ring) (#\D)))
 166 (set-key (make-insert-fun 209) 'lyrics-table '((:dead--tilde) (#\N)))
 167 (set-key (make-insert-fun 210) 'lyrics-table '((:dead--grave) (#\O)))
 168 (set-key (make-insert-fun 211) 'lyrics-table '((:dead--acute) (#\O)))
 169 (set-key (make-insert-fun 212) 'lyrics-table '((:dead--circumflex) (#\O)))
 170 (set-key (make-insert-fun 213) 'lyrics-table '((:dead--tilde) (#\O)))
 171 (set-key (make-insert-fun 214) 'lyrics-table '((:dead--diaeresis) (#\O)))
 172
 173 (set-key (make-insert-fun 216) 'lyrics-table '((:dead-above-ring) (#\O)))
 174 (set-key (make-insert-fun 217) 'lyrics-table '((:dead--grave) (#\U)))
 175 (set-key (make-insert-fun 218) 'lyrics-table '((:dead--acute) (#\U)))
 176 (set-key (make-insert-fun 219) 'lyrics-table '((:dead--circumflex) (#\U)))
 177 (set-key (make-insert-fun 220) 'lyrics-table '((:dead--diaeresis) (#\U)))
 178 (set-key (make-insert-fun 221) 'lyrics-table '((:dead--acute) (#\Y)))
 179
 180
 181 (set-key (make-insert-fun 224) 'lyrics-table '((:dead--grave) (#\a)))
 182 (set-key (make-insert-fun 225) 'lyrics-table '((:dead--acute) (#\a)))
 183 (set-key (make-insert-fun 226) 'lyrics-table '((:dead--circumflex) (#\a)))
 184 (set-key (make-insert-fun 227) 'lyrics-table '((:dead--tilde) (#\a)))
 185 (set-key (make-insert-fun 228) 'lyrics-table '((:dead--diaeresis) (#\a)))
 186 (set-key (make-insert-fun 229) 'lyrics-table '((:dead-above-ring) (#\a)))
 187 (set-key (make-insert-fun 230) 'lyrics-table '((:dead-above-ring) (#\e)))
 188 (set-key (make-insert-fun 231) 'lyrics-table '((:dead--tilde) (#\c)))
 189 (set-key (make-insert-fun 232) 'lyrics-table '((:dead--grave) (#\e)))
 190 (set-key (make-insert-fun 233) 'lyrics-table '((:dead--acute) (#\e)))
 191 (set-key (make-insert-fun 234) 'lyrics-table '((:dead--circumflex) (#\e)))
 192 (set-key (make-insert-fun 235) 'lyrics-table '((:dead--diaeresis) (#\e)))
 193 (set-key (make-insert-fun 236) 'lyrics-table '((:dead--grave) (#\i)))
 194 (set-key (make-insert-fun 237) 'lyrics-table '((:dead--acute) (#\i)))
 195 (set-key (make-insert-fun 238) 'lyrics-table '((:dead--circumflex) (#\i)))
 196 (set-key (make-insert-fun 239) 'lyrics-table '((:dead--diaeresis) (#\i)))
 197
 198
 199 (set-key (make-insert-fun 242) 'lyrics-table '((:dead--grave) (#\o)))
 200 (set-key (make-insert-fun 243) 'lyrics-table '((:dead--acute) (#\o)))
 201 (set-key (make-insert-fun 244) 'lyrics-table '((:dead--circumflex) (#\o)))
 202 (set-key (make-insert-fun 245) 'lyrics-table '((:dead--tilde) (#\o)))
 203 (set-key (make-insert-fun 246) 'lyrics-table `((:dead--diaeresis) (#\o)))
 204
 205 (set-key (make-insert-fun 248) 'lyrics-table '((:dead-above-ring) (#\o)))
 206 (set-key (make-insert-fun 249) 'lyrics-table '((:dead--grave) (#\u)))
 207 (set-key (make-insert-fun 250) 'lyrics-table '((:dead--acute) (#\u)))
 208 (set-key (make-insert-fun 251) 'lyrics-table '((:dead--circumflex) (#\u)))
 209 (set-key (make-insert-fun 252) 'lyrics-table '((:dead--diaeresis) (#\u)))
 210 (set-key (make-insert-fun 253) 'lyrics-table '((:dead--acute) (#\y)))
 211
 212 (set-key (make-insert-fun 255) 'lyrics-table '((:dead--diaeresis) (#\y)))