+(define-builtin-markup-command (fret-diagram-terse layout props definition-string)
+ (string?)
+ "Make a fret diagram markup using terse string-based syntax.
+
+Here an example
+
+@example
+\\markup \\fret-diagram-terse #\"x;x;o;2;3;2;\"
+@end example
+
+@noindent
+for a D@tie{}chord diagram.
+
+Syntax rules for @var{definition-string}:
+
+@itemize @bullet
+
+@item
+Strings are terminated by semicolons; the number of semicolons
+is the number of strings in the diagram.
+
+@item
+Mute strings are indicated by @samp{x}.
+
+@item
+Open strings are indicated by @samp{o}.
+
+@item
+A number indicates a fret indication at that fret.
+
+@item
+If there are multiple fret indicators desired on a string, they
+should be separated by spaces.
+
+@item
+Fingerings are given by following the fret number with a @code{-},
+followed by the finger indicator, e.g. @samp{3-2} for playing the third
+fret with the second finger.
+
+@item
+Where a barre indicator is desired, follow the fret (or fingering) symbol
+with @code{-(} to start a barre and @code{-)} to end the barre.
+
+@end itemize"
+;TODO -- change syntax to fret\string-finger
+ (let ((definition-list (fret-parse-terse-definition-string props definition-string)))
+ (make-fret-diagram layout (car definition-list) (cdr definition-list))))
+
+(define (fret-parse-terse-definition-string props definition-string)
+ "parse a fret diagram string that uses terse syntax; return a pair containing:
+ props, modified to include the string-count determined by the definition-string
+ a fret-indication list with the appropriate values"
+;TODO -- change syntax to fret\string-finger
+ (let* ((barre-start-list '())
+ (output-list '())
+ (new-props '())
+ (items (string-split definition-string #\;))
+ (string-count (- (length items) 1)))
+ (let parse-item ((myitems items))
+ (if (not (null? (cdr myitems)))
+ (let* ((test-string (car myitems))
+ (current-string (- (length myitems) 1))
+ (indicators (string-split test-string #\ )))
+ (let parse-indicators ((myindicators indicators))
+ (if (not (eq? '() myindicators))
+ (let* ((this-list (string-split (car myindicators) #\-))
+ (max-element-index (- (length this-list) 1))
+ (last-element (car (list-tail this-list max-element-index)))
+ (fret (if (string->number (car this-list)) (string->number (car this-list)) (car this-list))))
+ (if (equal? last-element "(")
+ (begin
+ (set! barre-start-list (cons-fret (list current-string fret) barre-start-list))
+ (set! this-list (list-head this-list max-element-index))))
+ (if (equal? last-element ")")
+ (let* ((this-barre (get-sub-list fret barre-start-list))
+ (insert-index (- (length this-barre) 1)))
+ (set! output-list (cons-fret (cons* 'barre (car this-barre) current-string (cdr this-barre))
+ output-list))
+ (set! this-list (list-head this-list max-element-index))))
+ (if (number? fret)
+ (set! output-list (cons-fret (cons* 'place-fret current-string (drop-paren (numerify this-list))) output-list))
+ (if (equal? (car this-list) "x" )
+ (set! output-list (cons-fret (list 'mute current-string) output-list))
+ (set! output-list (cons-fret (list 'open current-string) output-list))))
+ (parse-indicators (cdr myindicators)))))
+ (parse-item (cdr myitems)))))
+ (set! new-props (acons 'string-count string-count new-props))
+
+ `(,(cons new-props props) . ,output-list)))
+
+(define (drop-paren item-list)
+" drop a final parentheses from a fret indication list resulting from a terse string specification of barre."
+ (if (> (length item-list) 0)
+ (let* ((max-index (- (length item-list) 1))
+ (last-element (car (list-tail item-list max-index))))
+ (if (or (equal? last-element ")") (equal? last-element "("))
+ (list-head item-list max-index)
+ item-list))
+ item-list))
+
+(define (get-sub-list value master-list)
+" Get a sub-list whose cadr is equal to @var{value} from @var{master-list}"
+ (if (eq? master-list '())
+ #f
+ (let ((sublist (car master-list)))
+ (if (equal? (cadr sublist) value)
+ sublist
+ (get-sub-list value (cdr master-list))))))