;;;; This file is part of LilyPond, the GNU music typesetter.
;;;;
-;;;; Copyright (C) 2002--2012 Jan Nieuwenhuizen <janneke@gnu.org>
+;;;; Copyright (C) 2002--2015 Jan Nieuwenhuizen <janneke@gnu.org>
;;;; Patrick McCarty <pnorcks@gmail.com>
;;;;
;;;; LilyPond is free software: you can redistribute it and/or modify
;; Helper functions
(define-public (attributes attributes-alist)
- (apply string-append
- (map (lambda (x)
- (let ((attr (car x))
- (value (cdr x)))
- (if (number? value)
- (set! value (ly:format "~4f" value)))
- (format #f " ~s=\"~a\"" attr value)))
- attributes-alist)))
+ (string-concatenate
+ (map (lambda (x)
+ (let ((attr (car x))
+ (value (cdr x)))
+ (if (number? value)
+ (set! value (ly:format "~4f" value)))
+ (format #f " ~s=\"~a\"" attr value)))
+ attributes-alist)))
(define-public (eo entity . attributes-alist)
"o = open"
"c = close"
(format #f "</~S>\n" entity))
-(define (start-enclosing-id-node s)
- (string-append "<g id=\"" s "\">\n"))
+(define (start-group-node attributes)
+ (define attributes-string
+ (string-concatenate
+ (map (lambda (item)
+ (ly:format " ~a=\"~a\"" (car item) (cdr item)))
+ attributes)))
+ (string-append "<g" attributes-string ">\n"))
-(define (end-enclosing-id-node)
+(define (end-group-node)
"</g>\n")
(define-public (comment s)
(string-append "<!-- " s " -->\n"))
(define-public (entity entity string . attributes-alist)
- (if (equal? string "")
+ (if (string-null? string)
(apply eoc entity attributes-alist)
(string-append
- (apply eo (cons entity attributes-alist)) string (ec entity))))
+ (apply eo entity attributes-alist) string (ec entity))))
(define (offset->point o)
(ly:format "~4f ~4f" (car o) (- (cdr o))))
(define (helper lst)
(if (null? lst)
'()
- (cons (format #f "~S ~S" (car lst) (- (cadr lst)))
+ (cons (ly:format "~4f ~4f" (car lst) (- (cadr lst)))
(helper (cddr lst)))))
(string-join (helper lst) " "))
(integer->entity (char->integer char)))
(define (string->entities string)
- (apply string-append
- (map (lambda (x) (char->entity x)) (string->list string))))
+ (string-concatenate
+ (map char->entity (string->list string))))
(define svg-element-regexp
(make-regexp "^(<[a-z]+) ?(.*>)"))
(if (not (ly:get-option 'svg-woff)) embedded-glyph-string woff-glyph-string))
(define (grob-cause offset grob)
- "")
+ (and (ly:get-option 'point-and-click)
+ (let* ((cause (ly:grob-property grob 'cause))
+ (music-origin (if (ly:stream-event? cause)
+ (ly:event-property cause 'origin)))
+ (point-and-click (ly:get-option 'point-and-click)))
+ (and (ly:input-location? music-origin)
+ (cond ((boolean? point-and-click) point-and-click)
+ ((symbol? point-and-click)
+ (ly:in-event-class? cause point-and-click))
+ (else (any (lambda (t)
+ (ly:in-event-class? cause t))
+ point-and-click)))
+ (let* ((location (ly:input-file-line-char-column music-origin))
+ (raw-file (car location))
+ (file (if (is-absolute? raw-file)
+ raw-file
+ (string-append (ly-getcwd) "/" raw-file))))
+
+ (ly:format "<a style=\"color:inherit;\" xlink:href=\"textedit://~a:~a:~a:~a\">\n"
+ ;; Backslashes are not valid
+ ;; file URI path separators.
+ (ly:string-percent-encode
+ (ly:string-substitute "\\" "/" file))
+
+ (cadr location)
+ (caddr location)
+ (1+ (cadddr location))))))))
(define (named-glyph font name)
(fontify font name))
-(define (no-origin)
- "")
+(define (no-origin) "</a>\n")
(define* (path thick commands #:optional (cap 'round) (join 'round) (fill? #f))
(define (convert-path-exps exps)
`(stroke-linecap . ,(symbol->string cap-style))
'(stroke . "currentColor")
`(fill . ,(if fill? "currentColor" "none"))
- `(d . ,(apply string-append (convert-path-exps commands))))))
+ `(d . ,(string-concatenate (convert-path-exps commands))))))
(define (placebox x y expr)
(if (string-null? expr)
'(fill . "currentColor")))
(define (setcolor r g b)
- (format #f "<g color=\"rgb(~a%, ~a%, ~a%)\">\n"
+ (ly:format "<g color=\"rgb(~4f%, ~4f%, ~4f%)\">\n"
(* 100 r) (* 100 g) (* 100 b)))
;; rotate around given point