+ (if (string? bar-glyph)
+ (let ((extents '())
+ (make-span-bars '())
+ (model-bar #f))
+
+ ;; we compute the extents of each system and store them
+ ;; in a list; dito for the 'allow-span-bar property.
+ ;; model-bar takes the bar grob, if given.
+ (for-each (lambda (bar)
+ (let ((ext (bar-line::bar-y-extent bar refp))
+ (staff-symbol (ly:grob-object bar 'staff-symbol)))
+
+ (if (ly:grob? staff-symbol)
+ (let ((refp-extent (ly:grob-extent staff-symbol refp Y)))
+
+ (set! ext (interval-union ext refp-extent))
+
+ (if (> (interval-length ext) 0)
+ (begin
+ (set! extents (append extents (list ext)))
+ (set! model-bar bar)
+ (set! make-span-bars
+ (append make-span-bars
+ (list (ly:grob-property
+ bar
+ 'allow-span-bar
+ #t))))))))))
+ elts)
+ ;; if there is no bar grob, we use the callback argument
+ (if (not model-bar)
+ (set! model-bar grob))
+ ;; we discard the first entry in make-span-bars,
+ ;; because its corresponding bar line is the
+ ;; uppermost and therefore not connected to
+ ;; another bar line
+ (if (pair? make-span-bars)
+ (set! make-span-bars (cdr make-span-bars)))
+ ;; the span bar reaches from the lower end of the upper staff
+ ;; to the upper end of the lower staff - when allow-span-bar is #t
+ (reduce (lambda (curr prev)
+ (let ((span-extent (cons 0 0))
+ (allow-span-bar (car make-span-bars)))
+
+ (set! make-span-bars (cdr make-span-bars))
+ (if (> (interval-length prev) 0)
+ (begin
+ (set! span-extent (cons (cdr prev)
+ (car curr)))
+ ;; draw the span bar only when the staff lines
+ ;; don't overlap and allow-span-bar is #t:
+ (and (> (interval-length span-extent) 0)
+ allow-span-bar
+ (set! span-bar
+ (ly:stencil-add
+ span-bar
+ (span-bar::compound-bar-line
+ model-bar
+ bar-glyph
+ span-extent))))))
+ curr))
+ "" extents)
+ (set! span-bar (ly:stencil-translate-axis
+ span-bar
+ (- (ly:grob-relative-coordinate grob refp Y))
+ Y))))
+ span-bar))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; volta bracket functions
+
+(define-public (allow-volta-hook bar-glyph)
+ "Allow the volta bracket hook being drawn over bar line @var{bar-glyph}."
+ (if (string? bar-glyph)
+ (set! volta-bracket-allow-volta-hook-list
+ (append volta-bracket-allow-volta-hook-list
+ (list bar-glyph)))
+ (ly:warning (_ ("Volta hook bar line must be a string; ignoring '~a'.")
+ bar-glyph))))
+
+(define-session volta-bracket-allow-volta-hook-list '())
+
+(define-public (volta-bracket::calc-hook-visibility bar-glyph)
+ "Determine the visibility of the volta bracket hook. It is called in
+@code{lily/volta-bracket.cc} and returns @code{#t} if @emph{no} hook
+should be drawn."
+ (not (member bar-glyph volta-bracket-allow-volta-hook-list)))
+
+(define-public (ly:volta-bracket::calc-shorten-pair grob)
+ "Calculate the @code{shorten-pair} values for an ideal placement
+of the volta brackets relative to the bar lines."
+ (let* ((line-thickness (layout-line-thickness grob))
+ (volta-half-line-thickness (* (ly:grob-property grob 'thickness 1.6)
+ line-thickness
+ 1/2))
+ (bar-array (ly:grob-object grob 'bars))
+ ;; the bar-array starts with the uppermost bar line grob that is
+ ;; covered by the left edge of the volta bracket; more (span)
+ ;; bar line grobs from other staves may follow
+ (left-bar-line (and (ly:grob-array? bar-array)
+ (positive? (ly:grob-array-length bar-array))
+ (ly:grob-array-ref bar-array 0)))
+ ;; we need the vertical-axis-group-index of the left-bar-line
+ ;; to find the corresponding right-bar-line
+ (vag-index (and left-bar-line
+ (ly:grob-get-vertical-axis-group-index left-bar-line)))
+ ;; the bar line corresponding to the right edge of the volta bracket
+ ;; is the last entry with the same vag-index, so we transform the array to a list,
+ ;; reverse it and search for the first suitable entry from
+ ;; the back
+ (right-bar-line (and left-bar-line
+ (find (lambda (e)
+ (eqv? (ly:grob-get-vertical-axis-group-index e)
+ vag-index))
+ (reverse (ly:grob-array->list bar-array)))))
+ ;; the left-bar-line may be a #'<Grob Item >,
+ ;; so we add "" as a fallback return value
+ (left-bar-glyph-name (if left-bar-line
+ (ly:grob-property left-bar-line 'glyph-name "")
+ (string annotation-char)))
+ (right-bar-glyph-name (if right-bar-line
+ (ly:grob-property right-bar-line 'glyph-name "")
+ (string annotation-char)))
+ ;; This is the original logic. It flags left-bar-broken if
+ ;; there is no left-bar-line. That seems strange.
+ (left-bar-broken (not (and left-bar-line
+ (zero? (ly:item-break-dir left-bar-line)))))
+ (right-bar-broken (not (and right-bar-line
+ (zero? (ly:item-break-dir
+ right-bar-line)))))
+ ;; Revert to current grob for getting layout info if no
+ ;; left-bar-line available
+ (left-span-stencil-extent (ly:stencil-extent
+ (span-bar::compound-bar-line
+ (or left-bar-line grob)
+ left-bar-glyph-name
+ dummy-extent)
+ X))
+ (right-span-stencil-extent (ly:stencil-extent
+ (span-bar::compound-bar-line
+ (or right-bar-line grob)
+ right-bar-glyph-name
+ dummy-extent)
+ X))
+ (left-shorten 0.0)
+ (right-shorten 0.0))
+
+ ;; since "empty" intervals may look like (1.0 . -1.0), we use the
+ ;; min/max functions to make sure that the placement is not corrupted
+ ;; in case of empty bar lines
+ (set! left-shorten
+ (if left-bar-broken
+ (- (max 0 (interval-end left-span-stencil-extent))
+ (max 0 (interval-end (ly:stencil-extent
+ (bar-line::compound-bar-line
+ (or left-bar-line grob)
+ left-bar-glyph-name
+ dummy-extent)
+ X)))
+ volta-half-line-thickness)
+ (- (max 0 (interval-end left-span-stencil-extent))
+ volta-half-line-thickness)))
+
+ (set! right-shorten
+ (if right-bar-broken
+ (+ (- (max 0 (interval-end right-span-stencil-extent)))
+ volta-half-line-thickness)
+ (- (min 0 (interval-start right-span-stencil-extent))
+ volta-half-line-thickness)))
+
+ (cons left-shorten right-shorten)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; predefined bar glyph print procedures
+
+(add-bar-glyph-print-procedure "" make-empty-bar-line)
+(add-bar-glyph-print-procedure "|" make-simple-bar-line)
+(add-bar-glyph-print-procedure "." make-thick-bar-line)
+(add-bar-glyph-print-procedure "!" make-dashed-bar-line)
+(add-bar-glyph-print-procedure "'" make-tick-bar-line)
+(add-bar-glyph-print-procedure ":" make-colon-bar-line)
+(add-bar-glyph-print-procedure ";" make-dotted-bar-line)
+(add-bar-glyph-print-procedure "k" make-kievan-bar-line)
+(add-bar-glyph-print-procedure "S" (make-segno-bar-line #t))
+(add-bar-glyph-print-procedure "=" (make-segno-bar-line #f))
+(add-bar-glyph-print-procedure "[" (make-bracket-bar-line LEFT))
+(add-bar-glyph-print-procedure "]" (make-bracket-bar-line RIGHT))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; predefined bar lines
+;;
+;; definition of bar lines goes as follows:
+;;
+;; (define-bar-line "normal bar[-annotation]" "end of line" "start of line" "span bar")
+;;
+;; each entry has to be a string or #f.
+;; The empty string "" is allowed and yields in an invisible bar line,
+;; whereas #f reads 'no stencil'.
+;;
+;; Convention: if two bar lines would be identical in their
+;; unbroken bar glyph, we use annotations to make them distinct;
+;; as a general rule of thumb the main difference in their
+;; behavior at the end of a line is used as annotation, cf.
+;;
+;; (define-bar-line ".|:" "|" ".|:" ".|")
+;; (define-bar-line ".|:-||" "||" ".|:" ".|")
+;;
+;; or
+;;
+;; (define-bar-line "S-|" "|" "S" "=")
+;; (define-bar-line "S-S" "S" "" "=")
+
+;; common bar lines
+(define-bar-line "" "" "" #f)
+(define-bar-line "-" #f #f #f)
+(define-bar-line "|" "|" #f "|")
+(define-bar-line "|-s" #f "|" "|")
+(define-bar-line "." "." #f ".")
+(define-bar-line ".|" "|" ".|" ".|")
+(define-bar-line "|." "|." #f "|.")
+(define-bar-line "||" "||" #f "||")
+(define-bar-line ".." ".." #f "..")
+(define-bar-line "|.|" "|.|" #f "|.|")
+(define-bar-line "!" "!" #f "!")
+(define-bar-line ";" ";" #f ";")
+(define-bar-line "'" "'" #f #f)
+
+;; repeats
+(define-bar-line ":|.:" ":|." ".|:" " |.")
+(define-bar-line ":..:" ":|." ".|:" " ..")
+(define-bar-line ":|.|:" ":|." ".|:" " |.|")
+(define-bar-line ":.|.:" ":|." ".|:" " .|.")
+(define-bar-line ":|." ":|." #f " |.")
+(define-bar-line ".|:" "|" ".|:" ".|")
+(define-bar-line "[|:" "|" "[|:" " |")
+(define-bar-line ":|]" ":|]" #f " | ")
+(define-bar-line ":|][|:" ":|]" "[|:" " | |")
+(define-bar-line ".|:-||" "||" ".|:" ".|")
+
+;; segno bar lines
+(define-bar-line "S" "||" "S" "=")
+(define-bar-line "S-|" "|" "S" "=")
+(define-bar-line "S-S" "S" #f "=")
+(define-bar-line ":|.S" ":|." "S" " |.")
+(define-bar-line ":|.S-S" ":|.S" "" " |.")
+(define-bar-line "S.|:" "|" "S.|:" " .|")
+(define-bar-line "S.|:-S" "S" ".|:" " .|")
+(define-bar-line ":|.S.|:" ":|." "S.|:" " |. .|")
+(define-bar-line ":|.S.|:-S" ":|.S" ".|:" " |. .|")
+
+;; ancient bar lines
+(define-bar-line "k" "k" #f #f) ;; kievan style
+
+;; volta hook settings
+(allow-volta-hook ":|.")
+(allow-volta-hook ".|:")
+(allow-volta-hook "|.")
+(allow-volta-hook ":..:")
+(allow-volta-hook ":|.|:")
+(allow-volta-hook ":|.:")
+(allow-volta-hook ".|")
+(allow-volta-hook ":|.S")
+(allow-volta-hook ":|.S-S")
+(allow-volta-hook ":|.S.|:")
+(allow-volta-hook ":|.S.|:-S")
+(allow-volta-hook ":|]")
+(allow-volta-hook ":|][|:")