\version "2.18.0"
% \version "2.19.11"


#(define (add-dot text?)
  ;; Sets a grob' stencil-property by adding a red dot and an optional text
  ;; to the actual grob-stencil.
  (lambda (grob)
      (let* ((layout (ly:grob-layout grob))
             (props (layout-extract-page-properties layout))
             (font
               (ly:paper-get-font layout
                 (cons '((font-encoding . fetaMusic)) props)))
             ;; Get the stencil-procedure from ly:grob-basic-properties.
             ;; If any, use it to create the stencil.
             (function (assoc-get 'stencil (ly:grob-basic-properties grob)))
             (stencil (if function (function grob) point-stencil))
             ;; Get the grob-name and create a text-stencil.
             ;; Read out the y-length for later translate.
             (grob-name-proc
                (lambda (x) (assq-ref (ly:grob-property x 'meta) 'name)))
             (grob-name (grob-name-proc grob))
             (grob-string (if (symbol? grob-name)
                              (symbol->string grob-name)
                              "no name"))
             (ref-text-stil (grob-interpret-markup grob
                                  (markup
                                     #:with-color red
                                     #:normal-text
                                     #:abs-fontsize 6
                                     (string-append "   " grob-string))))
             (ref-text-stil-length
                (interval-length (ly:stencil-extent ref-text-stil Y)))
             (grob-string-stil (if text? (grob-interpret-markup grob
                                  (markup
                                     #:with-dimensions '(0 . 0) '(0 . 0)
                                     #:stencil
                                     ref-text-stil))
                                     point-stencil
                                     ))
             ;; Create a red-dot-stencil
             (dot (ly:font-get-glyph font "dots.dot"))
             (red-dot (ly:stencil-in-color dot 1 0 0))
             (red-dot-length
                (interval-length (ly:stencil-extent red-dot X)))
             (red-dot-stil
                (ly:stencil-translate-axis red-dot (/ red-dot-length -2) X)))

      ;; If there's a grob with stencil-procedure and a valid stencil is
      ;; created, add the red-dot-stil and an optional text-stencil.
      (if (and function (ly:stencil? stencil) ) ;; and: (grob::is-live? grob)  ???
          (ly:grob-set-property! grob 'stencil
            (ly:stencil-add
              stencil
              red-dot-stil
                (ly:stencil-translate-axis
                  (ly:stencil-rotate
                    grob-string-stil
                    90 0 0)
                    (/ ref-text-stil-length 2)
                    X)))))))

% needs to be here for 2.16.2
#(define-public (symbol-list-or-symbol? x)
  (if (list? x)
      (every symbol? x)
      (symbol? x)))

#(define (add-red-dot-to-grobs override? text? l)
 ;; Applies @code{(add-dot text?)} via after-line-breaking to the specified 
 ;; grob(s) in @code{l}
 ;;
 ;; possible values for l:
 ;;   'all-grobs (adds red-dots to all grobs, where possible)
 ;;          this will naturally cause collisions,
 ;;   a single grob-name, must be a symbol,
 ;;   a list of grob-names,
 ;;   anything else (returns the unchanged original stencil)
 ;;  TODO: How to apply it once?
  (let ((grobs-to-consider
          (cond ((eq? l 'all-grobs)
                  all-grob-descriptions)
                ((symbol? l)
                  (list (assoc l all-grob-descriptions)))
                ((list? l)
                  (map
                    (lambda (grob)
                      (assoc grob all-grob-descriptions))
                      l))
                (else '()))))

  (lambda (context)
   (let loop ((x grobs-to-consider))
    (if (not (null? x))
     (let ((grob-name (caar x)))
      (ly:context-pushpop-property
         context
         grob-name
         'after-line-breaking
         (if override?
            (add-dot text?) '())
         )
      (loop (cdr x))))))))

printRefpointOn =
#(define-music-function (parser location text? s-or-l)
   (boolean? symbol-list-or-symbol?)
"
 Adds a red dot (and an optional text) to the stencil's ref-point of the
 specified grob(s).
 Valid input for s-or-l:
      @code{'all-grobs}, (adds red-dots to all grobs, where possible), this will
          naturally cause collisions,
      a single grob-name, must be a symbol,
      a list of grob-names.
 The additional text may be activated by @code{##t}.
 To avoid bleeding-overs any context has to be initiated explicitly.
"
#{
        \applyContext #(add-red-dot-to-grobs #t text? s-or-l)
#})

printRefpointOff =
#(define-music-function (parser location text? s-or-l)
   (boolean? symbol-list-or-symbol?)
"
 Adds a red dot (and an optional text) to the stencil's ref-point of the
 specified grob(s).
 Valid input for s-or-l:
      @code{'all-grobs}, (adds red-dots to all grobs, where possible), this will
          naturally cause collisions,
      a single grob-name, must be a symbol,
      a list of grob-names.
 The additional text may be activated by @code{##t}.
 To avoid bleeding-overs any context has to be initiated explicitly.
"
#{
        \applyContext #(add-red-dot-to-grobs #f text? s-or-l)
#})


#(define-markup-command (vertical-remark layout props mrkp)(markup?)
    (let* ((stil (interpret-markup layout props mrkp))
           (x-length (interval-length (ly:stencil-extent stil X)))
           (y-height (interval-length (ly:stencil-extent stil Y)))
           )
       (ly:stencil-translate-axis
         (ly:stencil-rotate
           stil
           90 0 0)
           (+ (/ x-length -2) (/ y-height 2))
           X)))
           
remark =
#(define-scheme-function (parser location mrkp)(markup?)
#{
	\markup \vertical-remark #mrkp
#})
           

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

\header { 
  title = \markup \fill-line { \bold \concat { "Version: " #(lilypond-version) } " " }
}

my-layout = {
      % draw boxes around grobs, representing their extents
      \override DynamicText.stencil =
        #(make-stencil-boxer 0.03 0 ly:text-interface::print)
      \override NoteHead.stencil =
        #(make-stencil-boxer 0.03 0 ly:note-head::print)
}

\markup {
  \override #'(baseline-skip . 25)
  \column {
    \vspace #1
    \underline "Testing self-alignment-X with DynamicText:"
    \fill-line {
      \score {
        \new Staff {
          \printRefpointOn ##f #'(DynamicText NoteHead)
          
          \override DynamicText.self-alignment-X = #RIGHT
          % forte's right edge is aligned with notehead's right edge
          c'4\f^\remark "RIGHT"
          \override DynamicText.self-alignment-X = #LEFT
          % forte's left edge is aligned with notehead's left edge
          c'4\f^\remark "LEFT"
          % forte's center is aligned with notehead's center
          \override DynamicText.self-alignment-X = #CENTER
          c'4\f^\remark "CENTER=default"
        }
        \layout {
          % draw boxes around grobs, representing their extents
          \override DynamicText.stencil =
            #(make-stencil-boxer 0.03 0 ly:text-interface::print)
          \override NoteHead.stencil =
            #(make-stencil-boxer 0.03 0 ly:note-head::print)
        }
      }
      
      \score {
        % see what happens when we use wider dynamics:
        \new Staff {

          \printRefpointOn ##f #'(DynamicText NoteHead)
          \override DynamicText.self-alignment-X = #RIGHT
          % forte's right edge is aligned with notehead's right edge
          c'2\fff^\remark "RIGHT"
          \override DynamicText.self-alignment-X = #LEFT
          % forte's left edge is aligned with notehead's left edge
          c'\fff^\remark "LEFT"
          
          \override DynamicText.self-alignment-X = #CENTER
          c'2\fff^\remark "CENTER=default"
        }
        \layout { \my-layout }
      }
      " "
    }
  \vspace #1
  }
}

\markup \underline "Testing self-alignment-X with TextScript:"

\score {
  \new Staff {
  	\printRefpointOn ##f #'(TextScript NoteHead)
  	c1\f
  	\override TextScript.self-alignment-X = #CENTER
  	d^"Some long text"
  	\break
  	c
  	\override TextScript.self-alignment-X = #LEFT
  	d^"Some long text"
  	\break
  	c
  	\override TextScript.self-alignment-X = #RIGHT
  	d^"Some long text"
  }
  \layout { 
  	  line-width = 80
  	  \my-layout 
          % draw boxes around grobs, representing their extents
          \override TextScript.stencil =
            #(make-stencil-boxer 0.03 0 ly:text-interface::print)
          \override NoteHead.stencil =
            #(make-stencil-boxer 0.03 0 ly:note-head::print)
  }
}