lib/deprec.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- deprec.scm                                         ;
   3 ;                                                                  ;
   4 ; (c) 2008-2010 Valentin Villenave <valentin@villenave.net>        ;
   5 ;                                                                  ;
   6 ;     opus_libre is a free framework for GNU LilyPond: you may     ;
   7 ; redistribute it and/or modify it under the terms of the GNU      ;
   8 ; General Public License, version 3 or later: gnu.org/licenses     ;
   9 ;                                                                  ;
  10 ;------------------------------------------------------------------;
  11
  12 ;; deprecated (however cool) functions.
  13 ;; This file is not loaded by default.
  14
  15
  16 ; http://sourceware.org/ml/guile/2000-06/msg00069.html
  17 (define (grep rx strings)
  18  (let ((r (make-regexp rx)))
  19   (filter (lambda (x) (regexp-exec r x)) strings)))
  20
  21 (define (directory->list dir)
  22   (let ((dport (opendir dir)))
  23    (let loop ((entry (readdir dport))
  24         (files '()))
  25      (if (not (eof-object? entry))
  26    (loop (readdir dport) (cons entry files))
  27    (begin
  28      (closedir dport)
  29      (reverse! files))))))
  30
  31
  32 ;; issue #442 workaround, no longer needed
  33
  34 (define (remove music) ; throw everything into the Big Void...
  35  (context-spec-music music 'Devnull))
  36
  37 (define (unpitch music)
  38   ; in addition to the PitchSquash thing, we need to make
  39   ; accidentals disappear (since these are engraved at a
  40   ; Staff level, and since we don't want to affect the
  41   ; real Voice).
  42   (let* ((es (ly:music-property music 'elements))
  43          (e (ly:music-property music 'element))
  44          (p (ly:music-property music 'pitch)))
  45     (if (pair? es)
  46         (ly:music-set-property!
  47          music 'elements
  48          (map (lambda (x) (unpitch x)) es)))
  49     (if (ly:music? e)
  50         (ly:music-set-property!
  51          music 'element
  52          (unpitch e)))
  53     (if (ly:pitch? p)
  54           (ly:music-set-property! music 'pitch 0)))
  55    music)
  56
  57 (define (event-filter event)
  58  (let ((n (ly:music-property event 'name)))
  59   (if (or
  60     (eq? n 'ContextSpeccedMusic) ; to avoid clefs and ottavas
  61     (eq? n 'ContextChange) ; cross-staff voices are supported
  62     (eq? n 'ArpeggioEvent)) ; arpeggios need to go too
  63     (music-map remove event))
  64   (if (eq? n 'SimultaneousMusic) ; we don't want a new Voice to be created
  65     (ly:music-set-property! event 'name 'NoteEvent))))
  66
  67 (define makeGhost
  68 (define-music-function (parser location music) (ly:music?)
  69  (context-spec-music (music-filter event-filter (unpitch music)) 'PseudoVoice)))
  70
  71 (define showAnyWay
  72 (define-music-function (parser location music) (ly:music?)
  73 #{
  74   \unset Score.keepAliveInterfaces
  75   $music
  76   \set Score.keepAliveInterfaces = #'(rhythmic-grob-interface
  77   lyric-interface percent-repeat-item-interface
  78   percent-repeat-interface stanza-number-interface)
  79 #}))