\version "2.14.2"

extendSlur =
#(define-music-function (parser location x) (pair?)
#{
        \once  \override Slur #'stencil = #(lambda (grob)
	(let* ((slur-stencil (ly:slur::print grob))
	       (slur-ext (ly:stencil-extent slur-stencil X))
	       (slur-length (interval-length slur-ext))
	       (new-slur-length (+ slur-length (- (cdr $x)(car $x))))
	       (scale-factor (/ new-slur-length slur-length))
	       (x-shift (car $x)))
	
	(ly:stencil-translate-axis
	   (ly:stencil-scale slur-stencil scale-factor 1)
	   x-shift 
	   X)))
#})

\relative c'' {
        \set Staff.instrumentName = "extendSlur "
   % Der Anfangspunkt desBogens soll um 2 Staffspaces nach links,
   % der Endpunkt um 2 nach rechts verschoben werden:
   \extendSlur #'(-2 . 2) f (e d f)
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
% http://lsr.dsi.unimi.it/LSR/Snippet?id=639 :
% http://lists.gnu.org/archive/html/lilypond-user/2007-08/msg00539.html
% http://lists.gnu.org/archive/html/lilypond-user/2009-09/msg00495.html
% thanks, Neil!!

%%%%%%%%%%%%%%%%%%%%% Slur -----------------------------------------------------

#(define ((alter-curve offsets) grob)
   ;; get default control-points
   (let ((coords (ly:slur::calc-control-points grob)))
     ;; add offsets to default coordinates
     (define (add-offsets coords offsets)
       (if (null? coords)
       '()
       (cons
         (cons (+ (caar coords) (car offsets))
               (+ (cdar coords) (cadr offsets)))
         (add-offsets (cdr coords) (cddr offsets)))))

     (if (null? offsets)
         coords
         (add-offsets coords offsets))))


#(define ((shape-slur offsets) grob)
   (let* (
          ;; have we been split?
          (orig (ly:grob-original grob))
          ;; if yes, get the split pieces (our siblings)
          (siblings (if (ly:grob? orig)
                        (ly:spanner-broken-into orig) '() ))
          (total-found (length siblings)))
     (if (>= total-found 2)
         ;; shape BROKEN
         ;; walk through siblings, find index in list
         ;; and apply offsets from list of offsets:
         (let loop ((n 0))
                   (if (eq? (list-ref siblings n) grob)
                       ;; return altered:
                       ((alter-curve (list-ref offsets n)) grob)
                       (if (< n total-found)
                           (loop (1+ n))
                           ;; end of list -- none found?!
                           ;; return defaults:
                           ((alter-curve '()) grob))))
         ;;
         ;; shape UNBROKEN
         ((alter-curve offsets) grob))))
         
#(define ((alter-Curve offsets) grob)
   ;; get default control-points
   (let ((coords (ly:tie::calc-control-points grob)))
     ;; add offsets to default coordinates
     (define (add-offsets coords offsets)
       (if (null? coords)
       '()
       (cons
         (cons (+ (caar coords) (car offsets))
               (+ (cdar coords) (cadr offsets)))
         (add-offsets (cdr coords) (cddr offsets)))))

     (if (null? offsets)
         coords
         (add-offsets coords offsets))))


#(define ((shape-tie offsets) grob)
   (let* (
          ;; have we been split?
          (orig (ly:grob-original grob))
          ;; if yes, get the split pieces (our siblings)
          (siblings (if (ly:grob? orig)
                        (ly:spanner-broken-into orig) '() ))
          (total-found (length siblings)))
     (if (>= total-found 2)
         ;; shape BROKEN
         ;; walk through siblings, find index in list
         ;; and apply offsets from list of offsets:
         (let loop ((n 0))
                   (if (eq? (list-ref siblings n) grob)
                       ;; return altered:
                       ((alter-Curve (list-ref offsets n)) grob)
                       (if (< n total-found)
                           (loop (1+ n))
                           ;; end of list -- none found?!
                           ;; return defaults:
                           ((alter-Curve '()) grob))))
         ;;
         ;; shape UNBROKEN
         ((alter-Curve offsets) grob))))

shapeSlur =
#(define-music-function (parser location offsets)
                        (list?)
  #{
    \once \override Slur #'control-points = #(shape-slur $offsets)
  #})
  
shapeTie =
#(define-music-function (parser location offsets)
                        (list?)
  #{
    \once \override Tie #'control-points = #(shape-tie $offsets)
  #})
  
shapePhrasingSlur =
#(define-music-function (parser location offsets)
                        (list?)
  #{
    \once \override PhrasingSlur #'control-points = #(shape-slur $offsets)
  #})
  
%------------------- Test: Slurs -----------------------------------------------
  
\relative c'' {              
        \set Staff.instrumentName = "Slurs"
  \once \override Slur #'color = #green
  \shapeSlur #'(
    ;; make them funny enough:
    (0 0  1 3  0 4  0 0)
    ;; shorten a bit:
    (2 0  2 0  0 1  0 0))
  c4( b \stemUp <d d'> \stemNeutral c
  \break
  a4 d c b)
  \break
  \once \override Slur #'color = #blue
  \shapeSlur #'(
    (0 0  1 3  0 4  0 0)
    (0 -7  -1 -9  0 -9  0 -4)
    ;; do not touch:
    ()
    (2 0  2 0  0 1  0 0))
  c4( b \stemUp <d d'> \stemNeutral c
  \break
  a4 d c b
  \break
  a4 d c b
  \break
  a4 d c b)
  \break
  % shape unbroken:
  \shapeSlur #'(0 -3  1 1  1 2  0 -3)
  c4( b \stemUp <d d'> \stemNeutral c)
}

\paper {
  indent = 20
  ragged-right = ##t
}

\header {
  tagline = ""
}
 
%-------------------- Test: Tie ------------------------------------------------

\version "2.13.28"
  
\relative c'' {
        \set Staff.instrumentName = "Ties"
  \once \override Tie #'color = #red
  \shapeTie #'(
    ;; make them funny enough:
    (0 0  0 5  0 7  0 0)
    ;; shorten a bit:
    (1 0  1 1  0 1  0 0))
  c1 ~ \break
  c
}

%-------------------------- Test: PhrasingSlur ---------------------------------
  
  \relative c'' {
          \set Staff.instrumentName = "PhrasingSlurs "
  \once \override PhrasingSlur #'color = #green
  \shapePhrasingSlur #'(
    ;; make them funny enough:
    (0 0  1 3  0 4  0 0)
    ;; shorten a bit:
    (0 0  2 0  0 1  0 0))
  c4\( b \stemUp <d d'> \stemNeutral c 
  \break
  a4 d c b\)
  \break
  \once \override PhrasingSlur #'color = #blue
  \shapePhrasingSlur #'(
    (0 0  1 3  0 4  0 0)
    (0 -7  -1 -9  0 -9  0 -4)
    ;; do not touch:
    ()
    (0 0  2 0  0 1  0 0))
  c4\( b \stemUp <d d'> \stemNeutral c 
  \break
  a4 d c b
  \break
  a4 d c b
  \break
  a4 d c b\)
  \break
  % shape unbroken:
  \shapePhrasingSlur #'(0 -3  1 1  1 2  0 -3)
  c4\( b \stemUp <d d'> \stemNeutral c\)
}

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

extendSlurII =
#(define-music-function (parser location ext)(pair?)
  (let ((offsets (list (car ext) 0  (/ (car ext) 2) 0  (/ (cdr ext) 2) 0  (cdr ext) 0))
  )
  #{
    \once \override Slur #'control-points = #(shape-slur $offsets)
  #}))
  
\relative c'' {
        \set Staff.instrumentName = "extendSlurII "
   \extendSlurII #'(-2 . 2) 
   f (e d f)
}