Re: Table des matières ordonnée

[Jean Abou Samra]

Bonjour,

Le 08/01/2021 à 11:50, Dominique Audéoud a écrit :
> Effectivement, l'erreur disparaît maintenant.
> Wouaouh! La fonction de tri marche super-bien !
> Merci grandement pour votre aide !
>
> Il reste encore 3 problèmes, si vous me permettez encore, et si c'est 
> possible :
>
> 1) Certains caractères spéciaux que j'utilise (Œ, À,É, etc) se 
> retrouvent à la fin.
> Comment peut-on les avoir dans l'ordre comme dans l'exemple ci-dessous ?


Misère, vous avez raison… Le pire, c'est que Guile 1.8 ne
comprend pas l'Unicode et qu'il faut donc, en plus de
définir manuellement une liste de substitutions à opérer
avant la comparaison comme celle qui remplace É par E,
écrire du code peu élégant et que je ne peux pas totalement
garantir pour gérer les accents qui sont représentés sur
plusieurs caractères.

(LilyPond est engagé depuis dix ans dans une transition
fort difficile vers Guile 2, qui, lui, prend en charge l'Unicode.
À l'heure actuelle, il est devenu possible de compiler LilyPond
avec Guile 2, le problème étant la performance qui est toujours
nettement inférieure.)


> 2) La table des matières résultante est compressée verticelement dans 
> une seule page, et est donc illisible. Est-il possible de désactiver 
> la compression de la page, et d'avoir des sauts de pages automatiques ?


Ce n'est pas ce qui se produit dans mes tests, la table des
matières est répartie automatiquement sur plusieurs pages.
Si cela ne marche toujours pas avec le nouveau code,
pourrez-vous donner un exemple complet ?

> 3) J'ai en fait plusieurs strophes (groupe de vers) par pièce.
> Peut-on faire la même chose avec une liste à 2 niveaux ?
> J'ai cru comprendre qu'avec la dernière version Lilypond, les tables 
> des matières fonctionnaient à plusieurs niveaux.

Exactement, c'est ce dont je parlais plus haut. Utiliser
ceci en même temps que la fonction de tri est possible,
mais un peu plus délicat.

Notez qu'un effet secondaire de cet ajout est que vous
ne pourrez plus écrire \tocItem "Chaîne" car l'argument
"Chaîne" serait pris comme le label et il manquerait un
argument. Donc, les formes possibles sont :

- avec label, pour déclarer une pièce faisant partie d'un
groupe :

    \tocItem label "Chaîne"

- avec label et autant de sous-labels que souhaité,
pour former des sous-groupes :

  \tocItem label.souslabel "Chaîne"

- sans label :

  \tocItem \default "Chaîne"

ou bien (astucieux)

  \tocItem \markup "Chaîne"


Le code repris :


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

\version "2.21.80"


#(define to-ascii-replacements
   '(("Â" . "A")
     ("â" . "a")
     ("À" . "A")
     ("à" . "a")
     ("Ä" . "A")
     ("ä" . "a")
     ("Æ" . "A")
     ("æ" . "a")
     ("Ç" . "C")
     ("ç" . "c")
     ("É" . "E")
     ("é" . "e")
     ("Ê" . "E")
     ("ê" . "e")
     ("È" . "E")
     ("è" . "e")
     ("Ë" . "E")
     ("ë" . "e")
     ("Î" . "I")
     ("î" . "i")
     ("Ï" . "I")
     ("ï" . "i")
     ("Ô" . "O")
     ("ô" . "o")
     ("Ö" . "O")
     ("ö" . "o")
     ("Œ" . "O")
     ("œ" . "o")
     ("Û" . "U")
     ("Ü" . "U")))

#(define char-replacements
   (map
     (lambda (entry)
       (cons
         ;;;; Dans le string->list de la chaîne avec le caractère
         ;;;; spécial se trouvent en fait deux caractères, #\303 et un
         ;;;; autre. On ne conserve que l'autre dans la liste
         ;;;; associative.
         (second (string->list (car entry)))
         (first (string->list (cdr entry)))))
     to-ascii-replacements))

#(define (normalize-string str)
   (apply string
          (filter-map
            (lambda (char)
              ;;;; On supprime les #\303 qui indiquent que le caractère
              ;;;; suivant est spécial.
              (if (char=? char #\303)
                  #f
                  (or
                    (assv-ref char-replacements char)
                    char)))
            (string->list str))))

#(define ((compare-func-from-key key-func key-compare) a b)
   (key-compare
     (key-func a)
     (key-func b)))

#(define toc-entry<?
   (compare-func-from-key
     (lambda (entry)
       (normalize-string (assq-ref (cdr entry) 'text)))
     string<?))


#(define (max-common-length-eq lst1 lst2)
   (cond ((null? lst1)
          0)
         ((null? lst2)
          0)
         ((eq? (car lst1)
               (car lst2))
          (1+ (max-common-length-eq
                (cdr lst1)
                (cdr lst2))))
         (else
           0)))

#(let ((toc-item-list (list))
       (path '(0))
       (level '()))
   (set! add-toc-item!
    (lambda* (markup-symbol text new-level)
               (let* ((new-level
                        (if (symbol? new-level)
                            (list new-level)
                            new-level))
                      (common-part-length
                        (max-common-length-eq
                          level
                          new-level))
                      (id (gensym "toc")))
                 (if (> (length path) (1+ common-part-length))
                     (set! path
                           (list-head path
                                      (1+ common-part-length))))
                 (list-set! path
                            (1- (length path))
                            (1+ (last path)))
                 (set! path
                       (append! path
                                (make-list
                                  (-
                                    (1+ (length new-level))
                                    (length path))
                                  1)))
                 (set! toc-item-list
                       (acons id `((text . ,text)
                                   (toc-markup . ,markup-symbol)
                                   (parents . ())
                                   (children . ())
                                   (path . ,(copy-tree path))
                                   (level . 0))
                              toc-item-list))
                 (set! level new-level)

                 #{ \label $id #})))
   (set! toc-items (lambda ()
                     (stable-sort (reverse toc-item-list) toc-entry<?))))


%%%% Redéfinition de la fonction \tocItem pour n'accepter
%%%% qu'une chaîne de caractères et pas un \markup quelconque,
%%%% car il faut pouvoir trier dans l'ordre alphabétique des
%%%% chaînes.

tocItem =
#(define-music-function (level text)
                        ((symbol-list-or-symbol? '()) string?)
   (add-toc-item! 'tocItemMarkup text level))

#(define-markup-list-command (table-of-contents layout props) ()
  #:properties ((baseline-skip))
  ( _i "Outputs the table of contents, using the paper variable
@code{tocTitleMarkup} for its title, then the list of lines
built using the @code{tocItem} music function.
Usage: @code{\\markuplist \\table-of-contents}" )
  (let* ((titleMarkup (ly:output-def-lookup layout
                                            'tocTitleMarkup))
         (indentMarkup (ly:output-def-lookup layout
                                             'tocIndentMarkup))
         (toplevelFormatter (ly:output-def-lookup layout
'tocFormatMarkup))
         ;;;; Lire la variable toc-no-separator
         (toc-no-separator (ly:output-def-lookup layout
'toc-no-separator))
         (toc-alist (toc-items)))
    (ly:output-def-set-variable! layout
                                 'label-alist-table
                                 (append (ly:output-def-lookup
                                           layout
                                           'label-alist-table)
                                         toc-alist))
    (cons (interpret-markup layout props titleMarkup)
          (space-lines
            baseline-skip
            (filter-map
              (lambda (toc-item)
                (let* ((label (car toc-item))
                       (alist (cdr toc-item))
                       (toc-markup (assoc-get 'toc-markup alist))
                       (text (assoc-get 'text alist))
                       (level (assoc-get 'level alist))
                       (children (assoc-get 'children alist))
                       (path (assoc-get 'path alist)))
                  ;;;; On n'affiche pas les entrées qui en contiennent
                  ;;;; d'autres, seulement le dernier niveau.
                  (if (null? children)
                    (interpret-markup
                     layout
                     (cons (list
                            (cons 'toc:page
                                  (markup #:with-link label
                                          #:page-ref label "XXX" "?"))
                            (cons 'toc:text
                                  (markup #:with-link label text))
                            (cons 'toc:label label)
                            (cons 'toc:level level)
                            (cons 'toc:path path)
                            (cons 'toc:toplevel-formatter 
toplevelFormatter)
                            ;;;; Pas d'indentation des sous-niveaux
                            (cons 'toc:indent indentMarkup))
                                               ;(make-line-markup
                                               ; (make-list level 
indentMarkup))))
                           props)
                     (ly:output-def-lookup layout
                                           toc-markup))
                    #f)))
              toc-alist)))))

#(define-markup-command
  (toc-path-with-separator layout props separator)
  (markup?)
  #:properties ((toc:path #f))
  (interpret-markup layout props #{
    \markup \line {
      #@(cdr (apply append
                    (zip (make-list (length toc:path)
                                    separator)
                         (map number->string toc:path))))
    }
  #}))

\paper {
  toc-no-separator = " : "
  tocItemMarkup = \markup
    \bold
    %%%% \on-the-fly #format-toc-toplevel
    \fill-line {
    \line { \fromproperty #'toc:indent \fromproperty #'toc:text }
    %%%% Au lieu du numéro de page, 'toc:page, on met le numéro
    %%%% de la pièce.
    %\fromproperty #'toc:page
    \toc-path-with-separator ":"
  }
}




%% Exemple (mots au hasard).

\markuplist \table-of-contents

\pageBreak

\tocItem zéphyr "Zéphyr (1)"
\tocItem zéphyr "Zéphyr (2)"
\tocItem galbe "Galbe"
\tocItem capitale.suiteUne "Première pièce du premier sous-groupe de 
Capitale"
\tocItem capitale.suiteUne "Deuxième pièce du premier sous-groupe de 
Capitale"
\tocItem capitale.suiteDeux "Première pièce du deuxième sous-groupe de 
Capitale"
\tocItem capitale.suiteDeux "Deuxième pièce du deuxième sous-groupe de 
Capitale"
\tocItem élision "Élision"


% La table des matières se répartit automatiquement
% sur plusieurs pages.
#(for-each
   (lambda (i)
     (add-score #{ \score { { \tocItem rien "Rien" c' } } #}))
   (iota 50))

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


> Simple question corollaire :
> Le code Lilypond ressemble étrangement à un langage de manipulation de 
> listes, de type Lisp.
> Est-ce que je me trompe ?

Comme l'a signalé Christophe, il s'agit de code Scheme.
LilyPond utilise l'interpréteur Guile, qui est le langage
d'extension officiel du projet GNU.

Nous avons un manuel (pas encore tout à fait complet)
sur les différentes possibilités pour programmer LilyPond
en Scheme :

http://lilypond.org/doc/v2.21/Documentation/extending/index.html

Voici également une ressource rudement utile pour
apprendre le langage Scheme lui-même, dans le
contexte de LilyPond :

https://scheme-book.ursliska.de/introduction/index.html


Cordialement,
Jean