lib/deprec.scm

   1 ;------------------------------------------------------------------;
   2 ; opus_libre -- deprec.scm                                         ;
   3 ;                                                                  ;
   4 ; (c) 2008-2011 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 as published by the Free Software         ;
   9 ; Foundation, either version 3 of the License, or (at your option) ;
  10 ; any later version.                                               ;
  11 ;     This program is distributed WITHOUT ANY WARRANTY; without    ;
  12 ; even the implied warranty of MERCHANTABILITY or FITNESS FOR A    ;
  13 ; PARTICULAR PURPOSE.  You should have received a copy of the GNU  ;
  14 ; General Public License along with this program (typically in the ;
  15 ; share/doc/ directory).  If not, see http://www.gnu.org/licenses/ ;
  16 ;                                                                  ;
  17 ;------------------------------------------------------------------;
  18
  19
  20 ;; deprecated (however cool) functions.
  21 ;; This file is not loaded by default.
  22
  23
  24 ; http://sourceware.org/ml/guile/2000-06/msg00069.html
  25 (define (grep rx strings)
  26  (let ((r (make-regexp rx)))
  27   (filter (lambda (x) (regexp-exec r x)) strings)))
  28
  29 (define (directory->list dir)
  30   (let ((dport (opendir dir)))
  31    (let loop ((entry (readdir dport))
  32         (files '()))
  33      (if (not (eof-object? entry))
  34    (loop (readdir dport) (cons entry files))
  35    (begin
  36      (closedir dport)
  37      (reverse! files))))))
  38
  39
  40 ;; issue #442 workaround, no longer needed
  41
  42 (define (remove music) ; throw everything into the Big Void...
  43  (context-spec-music music 'Devnull))
  44
  45 (define (unpitch music)
  46   ; in addition to the PitchSquash thing, we need to make
  47   ; accidentals disappear (since these are engraved at a
  48   ; Staff level, and since we don't want to affect the
  49   ; real Voice).
  50   (let* ((es (ly:music-property music 'elements))
  51          (e (ly:music-property music 'element))
  52          (p (ly:music-property music 'pitch)))
  53     (if (pair? es)
  54         (ly:music-set-property!
  55          music 'elements
  56          (map (lambda (x) (unpitch x)) es)))
  57     (if (ly:music? e)
  58         (ly:music-set-property!
  59          music 'element
  60          (unpitch e)))
  61     (if (ly:pitch? p)
  62           (ly:music-set-property! music 'pitch 0)))
  63    music)
  64
  65 (define (event-filter event)
  66  (let ((n (ly:music-property event 'name)))
  67   (if (or
  68     (eq? n 'ContextSpeccedMusic) ; to avoid clefs and ottavas
  69     (eq? n 'ContextChange) ; cross-staff voices are supported
  70     (eq? n 'ArpeggioEvent)) ; arpeggios need to go too
  71     (music-map remove event))
  72   (if (eq? n 'SimultaneousMusic) ; we don't want a new Voice to be created
  73     (ly:music-set-property! event 'name 'NoteEvent))))
  74
  75 (define makeGhost
  76 (define-music-function (music) (ly:music?)
  77  (context-spec-music (music-filter event-filter (unpitch music)) 'PseudoVoice)))
  78
  79 (define showAnyWay
  80 (define-music-function (music) (ly:music?)
  81 #{
  82   \unset Score.keepAliveInterfaces
  83   $music
  84   \set Score.keepAliveInterfaces = #'(rhythmic-grob-interface
  85   lyric-interface percent-repeat-item-interface
  86   percent-repeat-interface stanza-number-interface)
  87 #}))
  88