lilypond-auto-insert

lilypond-auto-insert.el (16020B)

---

 ;;; lilypond-auto-insert.el --- Comprehensive auto-insert for LilyPond  -*- lexical-binding: t; -*-
 
 ;; Copyright (C) 2020  Jamie Beardslee
 
 ;; Author: Jamie Beardslee <jdb@jamzattack.xyz>
 ;; URL: https://git.jamzattack.xyz/lilypond-auto-insert
 ;; Keywords: abbrev, lilypond, music, typesetting, convenience
 ;; Version: 2020.11.30
 ;; Package-Requires: ((emacs "24.4"))
 
 ;; This program is free software; you can redistribute it and/or modify
 ;; it under the terms of the GNU General Public License as published by
 ;; the Free Software Foundation, either version 3 of the License, or
 ;; (at your option) any later version.
 
 ;; This program is distributed in the hope that it will be useful,
 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 ;; GNU General Public License for more details.
 
 ;; You should have received a copy of the GNU General Public License
 ;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
 
 ;;; Commentary:
 
 ;;
 
 ;;; Code:
 
 ;;; Customization
 
 (defgroup lilypond-auto-insert nil
   "Comprehensive auto-insert for LilyPond"
   :prefix "lilypond-auto-insert-"
   :group 'convenience)
 
 (defcustom lilypond-auto-insert-use-midi-block t
   "Whether or not to insert a midi block."
   :group 'lilypond-auto-insert
   :type 'boolean)
 
 (defcustom lilypond-auto-insert-header-alist
   '(("title")
     ("composer")
     ("tagline" . "##f"))
   "A list of items to put in the \"\\header\" block.
 
 Each element is a cons of (VAR . VALUE).  The key is put on the
 left.
 
 If the VALUE is:
 1. nil:  Prompt for the value, and use the result.
 2. A string:  Use the string.
 3. A sexp:  Evaluate the sexp, and use the result.
 
 NOTE: unless nil, the value (cdr) isn't stringified in the
 output.  This is so you can use markup or scheme syntax."
   :group 'lilypond-auto-insert
   :type '(alist :key-type string
 		:value-type (choice (const :tag "Prompt" nil)
 				    (string :tag "String")
 				    (sexp :tag "ELisp"))))
 
 (defcustom lilypond-auto-insert-relative t
   "Whether or not to use relative syntax."
   :group 'lilypond-auto-insert
   :type 'boolean)
 
 (defcustom lilypond-auto-insert-prompt-for-global nil
   "Whether or not to prompt for the \"\\global\" section.
 
 If non-nil, you will be prompted for:
 - key
 - time signature
 - tempo"
   :group 'lilypond-auto-insert
   :type 'boolean)
 
 (defcustom lilypond-auto-insert-lilypond-version "2.20"
   "Version of the lilypond binary.
 
 Used in the \"\\version\" statement, so choose the version you use
 to compile lilypond documents."
   :group 'lilypond-auto-insert
   :type 'string)
 
 (defcustom lilypond-auto-insert-language nil
   "Language used for `lilypond-auto-insert'.
 
 If nil, no \"\\language\" statement will be added.
 
 See \"(lilypond-notation) Note names in other languages\" for the
 effects of this setting."
   :group 'lilypond-auto-insert
   :type 'string)
 
 
 ;;; Common insertions
 
 (defun lilypond-auto-insert-boilerplate ()
   "Insert boilerplate lilypond code.
 
 This inserts \"\\version\" and \"\\language\" statements.
 
 See `lilypond-auto-insert-lilypond-version' and
 `lilypond-auto-insert-language'."
 
   (mapconcat #'identity
 	     (list
 	      (format "\\version \"%s\"\n" lilypond-auto-insert-lilypond-version)
 	      (when lilypond-auto-insert-language
 		(format "\\language \"%s\"\n" lilypond-auto-insert-language)))
 	     ""))
 
 (defun lilypond-auto-insert-parse-header-item (item)
   "Parse ITEM to be used in the \"\\header\" block."
   (let ((key (car item))
 	(value (cdr item))
 	(str "  %s = %s\n"))
     (cond ((stringp value)
 	   (format str key value))
 	  ((null value)
 	   (let ((answer
 		  (read-string
 		   (concat (capitalize key) ": "))))
 	     (unless (string-empty-p answer)
 	       (format str key
 		       (format "\"%s\"" answer)))))
 	  ((listp value)
 	   (format str key (eval value))))))
 
 (defun lilypond-auto-insert-header ()
   "Insert a lilypond header block.
 
 The variable `lilypond-auto-insert-header-alist' determines the
 contents of the header.  See that variable's documentation for
 details."
   (format "\\header {\n%s}\n"
 	  (mapconcat #'lilypond-auto-insert-parse-header-item
 		     lilypond-auto-insert-header-alist
 		     "")))
 
 (defun lilypond-auto-insert-global ()
   "Define a \"global\" section.
 
 By default, this will be empty.  Set the variable
 `lilypond-auto-insert-prompt-for-global' to add some
 interactivity."
   (format "global = {\n%s\n}\n"
 	  (if lilypond-auto-insert-prompt-for-global
 	      (mapconcat #'identity
 			 (list (format "  \\key %s"
 				       (read-string "Key: "))
 			       (format "  \\time %s"
 				       (read-string "Time signature: "))
 			       (format "  \\tempo %s"
 				       (read-string "Tempo: (might need quotes) ")))
 			 "\n")
 	    "")))
 
 
 ;;; Instruments
 
 (defun lilypond-auto-insert-instruments (&rest instruments)
   "Insert a definition for INSTRUMENTS.
 
 If `lilypond-auto-insert-relative' is non-nil, this will also
 make the blocks relative.
 
 \(lilypond-auto-insert-instruments \"violin\" \"cello\") will
 return a string like the following:
 
   violin = \\relative {
     \\global
   }
 
   cello = \\relative {
     \\global
   }
 
 NOTE: \"global\" is also defined when `lilypond-auto-insert' is
 used properly."
   (mapconcat
    (lambda (i)
      (format "%s = %s{\n  \\global\n}\n" i
 	     (when lilypond-auto-insert-relative
 	       "\\relative ")))
    instruments
    "\n"))
 
 
 ;;; Staves and stuff
 
 (defun lilypond-auto-insert-score (&optional staves)
   "Insert a \"\\score\" block.
 
 Optional argument STAVES is a string (usually automatically
 generated) containing the staves to insert within the \"\\score\"
 block."
   (let ((content (concat staves
 			 (when lilypond-auto-insert-use-midi-block
 			   "  \\midi { }\n")
 			 "  \\layout { }\n")))
     (format "\\score {\n%s}\n" content)))
 
 (defun lilypond-auto-insert-staffgroup (&rest instruments)
   "Insert a staff group.
 
 INSTRUMENTS is a list of instruments that make up the staff
 group.
 
 \(lilypond-auto-insert-staffgroup \"violin\" \"cello\") will
 return a string like the following:
 
 \\new StaffGroup <<
   \\violin
   \\cello
 >>"
   (format "  \\new StaffGroup <<\n%s\n  >>\n"
 	  (mapconcat (lambda (i)
 		       (format "    \\%s" i))
 		     instruments
 		     "\n")))
 
 (defun lilypond-auto-insert-choir-staff (&rest voices)
   "Insert a choir staff.
 
 VOICES is a list of instruments that make up the staff
 group.
 
 \(lilypond-auto-insert-coir-staff \"soprano\" \"alto\" \"tenor\" \"bass\") will
 return a string like the following:
 
 \\new ChoirStaff <<
   \\soprano
   \\alto
   \\tenor
   \\bass
 >>"
   (format "  \\new ChoirStaff <<\n%s\n  >>\n"
 	  (mapconcat (lambda (v)
 		       (format "    \\%s" v))
 		     voices
 		     "\n")))
 
 (defun lilypond-auto-insert-plain-staff (instrument)
   "Insert a plain staff for a single INSTRUMENT.
 
 \(lilypond-auto-insert-plain-staff \"oboe\") will return a string
 like the following:
 
 \\new Staff {
   \\oboe
 }"
   (format "  \\new Staff {\n    \\%s\n  }\n" instrument))
 
 (defun lilypond-auto-insert-plain-staves (&rest instruments)
   "Insert plain staves for INSTRUMENTS.
 
 \(lilypond-auto-insert-plain-staves \"horn\" \"trumpet\") will
 return a string like the following:
 
 \\new Staff {
   \\horn
 }
 
 \\new Staff {
   \\trumpet
 }"
   (mapconcat
    #'lilypond-auto-insert-plain-staff
    instruments "\n"))
 
 (defun lilypond-auto-insert-simultaneous-plain-staves (&rest instruments)
   "Insert simultaneous plain staves for INSTRUMENTS.
 
 Like `lilypond-auto-insert-plain-staves', but surrounds with
 double angle brackets.
 \(lilypond-auto-insert-simultaneous-plain-staves \"horn\" \"trumpet\")
 will return a string like the following:
 
 <<
   \\new Staff {
     \\horn
   }
 
   \\new Staff {
     \\trumpet
   }
 >>"
   (format "<<\n%s>>"
 	  (replace-regexp-in-string "^\\(.*\\)" "  \\1"
 				    (apply #'lilypond-auto-insert-plain-staves instruments))))
 
 (defun lilypond-auto-insert-piano-staff ()
   "Insert a piano staff.
 
 Always the same, but I decided to use a function for
 consistency's sake.  The staff is split into two parts: top and
 bottom."
   "  \\new PianoStaff <<
     \\new Staff \\top
     \\new Staff \\bottom
   >>\n")
 
 (defun lilypond-auto-insert-piano-and-solo-staff (instrument)
   "Insert a piano staff and an INSTRUMENT staff.
 
 \(lilypond-auto-insert-piano-and-solo-staff \"tin_whistle\") will
 return a string like the following:
 
 <<
   \\new Staff {
      \\tin_whistle
   }
   \\new PianoStaff <<
     \\new Staff \\top
     \\new Staff \\bottom
   >>
 >>"
   (format "  <<\n%s\n%s>>\n"
 	  (lilypond-auto-insert-plain-staff instrument)
 	  (lilypond-auto-insert-piano-staff)))
 
 (defun lilypond-auto-insert-piano-and-etc-staff (&rest instruments)
   "Create a staff for piano and for INSTRUMENTS.
 
 \(lilypond-auto-insert-piano-and-etc-staff \"violin\" \"cello\")
  will return a string like the following:
 
 <<
   \\new Staff {
     \\violin
   }
   \\new Staff {
     \\cello
   }
   \\new PianoStaff <<
     \\new Staff \\top
     \\new Staff \\bottom
   >>
 >>"
   (format "  <<\n%s\n%s>>\n"
 	  (apply #'lilypond-auto-insert-plain-staves instruments)
 	  (lilypond-auto-insert-piano-staff)))
 
 
 ;;; Creating the final product
 
 ;;;###autoload
 (defun lilypond-auto-insert-piano ()
   "Create a blank document for solo piano.
 
 This will prompt for:
 - title
 - composer"
   (interactive)
   (mapconcat #'identity
 	     (list (lilypond-auto-insert-boilerplate)
 		   (lilypond-auto-insert-header)
 		   (lilypond-auto-insert-global)
 		   (lilypond-auto-insert-instruments "top" "bottom")
 		   (lilypond-auto-insert-score
 		    (lilypond-auto-insert-piano-staff)))
 	     "\n"))
 
 ;;;###autoload
 (defun lilypond-auto-insert-solo ()
   "Create a blank document for solo instrument.
 
 This will prompt for:
 - title
 - composer
 - instrument"
   (interactive)
   (let ((instrument))
     (mapconcat #'identity
 	       (list (lilypond-auto-insert-boilerplate)
 		     (lilypond-auto-insert-header)
 		     (lilypond-auto-insert-global)
 		     (progn
 		       (setq instrument (read-string "Solo Instrument: "))
 		       (while (string-empty-p instrument)
 			 (setq instrument (read-string "Solo Instrument (cannot be empty): ")))
 		       (lilypond-auto-insert-instruments instrument))
 		     (lilypond-auto-insert-score
 		      (lilypond-auto-insert-plain-staff instrument)))
 	       "\n")))
 
 ;;;###autoload
 (defun lilypond-auto-insert-piano-and-solo ()
   "Create a blank document for piano and another instrument.
 
 This will prompt for:
 - title
 - composer
 - instrument"
   (interactive)
   (let ((instrument))
     (mapconcat #'identity
 	       (list (lilypond-auto-insert-boilerplate)
 		     (lilypond-auto-insert-header)
 		     (lilypond-auto-insert-global)
 		     (progn
 		       (setq instrument (read-string "Solo Instrument: "))
 		       (while (string-empty-p instrument)
 			 (setq instrument (read-string "Solo Instrument (cannot be empty): ")))
 		       (lilypond-auto-insert-instruments instrument "top" "bottom"))
 		     (lilypond-auto-insert-score
 		      (lilypond-auto-insert-piano-and-solo-staff instrument)))
 	       "\n")))
 
 ;;;###autoload
 (defun lilypond-auto-insert-satb ()
   "Create a blank document for SATB.
 
 This wil prompt for:
 - title
 - composer"
   (interactive)
   (mapconcat #'identity
 	     (list (lilypond-auto-insert-boilerplate)
 		   (lilypond-auto-insert-header)
 		   (lilypond-auto-insert-global)
 		   (lilypond-auto-insert-instruments "soprano" "alto" "tenor" "bass")
 		   (lilypond-auto-insert-score
 		    (lilypond-auto-insert-choir-staff "soprano" "alto" "tenor" "bass")))
 	     "\n"))
 
 ;;;###autoload
 (defun lilypond-auto-insert-string-quartet ()
   "Create a blank document for string quartet.
 
 This wil prompt for:
 - title
 - composer"
   (interactive)
   (mapconcat #'identity
 	     (list (lilypond-auto-insert-boilerplate)
 		   (lilypond-auto-insert-header)
 		   (lilypond-auto-insert-global)
 		   (lilypond-auto-insert-instruments "voilin_one" "voilin_two" "viola" "cello")
 		   (lilypond-auto-insert-score
 		    (lilypond-auto-insert-staffgroup "voilin_one" "voilin_two" "viola" "cello")))
 	     "\n"))
 
 ;;;###autoload
 (defun lilypond-auto-insert-etc ()
   "Create a blank document for an unspecified group.
 
 This wil prompt for:
 - title
 - composer
 - as many instruments as you want - RET on empty input will end the list."
   (interactive)
   (let ((instruments))
     (mapconcat #'identity
 	       (list (lilypond-auto-insert-boilerplate)
 		     (lilypond-auto-insert-header)
 		     (lilypond-auto-insert-global)
 		     (apply #'lilypond-auto-insert-instruments
 			    (let ((instrument (read-string "Instrument: ")))
 			      (while (not (string-empty-p instrument))
 				(push instrument instruments)
 				(setq instrument (read-string "Instrument: ")))
 			      (setq instruments (nreverse instruments))))
 		     (lilypond-auto-insert-score
 		      (apply #'lilypond-auto-insert-simultaneous-plain-staves
 			     instruments)))
 	       "\n")))
 
 ;;;###autoload
 (defun lilypond-auto-insert-piano-etc ()
   "Create a blank document for an unspecified group with piano.
 
 This wil prompt for:
 - title
 - composer
 - as many instruments as you want - RET on empty input will end the list."
   (let ((instruments))
     (mapconcat #'identity
 	       (list (lilypond-auto-insert-boilerplate)
 		     (lilypond-auto-insert-header)
 		     (lilypond-auto-insert-global)
 		     (apply #'lilypond-auto-insert-instruments
 			    (let ((instrument (read-string "Instrument: ")))
 			      (while (not (string-empty-p instrument))
 				(push instrument instruments)
 				(setq instrument (read-string "Instrument: ")))
 			      (setq instruments (nreverse instruments))))
 		     (lilypond-auto-insert-instruments "top" "bottom")
 		     (lilypond-auto-insert-score
 		      (apply #'lilypond-auto-insert-piano-and-etc-staff
 			     instruments)))
 	       "\n")))
 
 (defun lilypond-auto-insert-four-part ()
   "Create a condensed four-part harmony.
 
 A piano staff with soprano and alto in the right hand, and tenor
 and bass in the left hand.
 
 The tenor and bass staff will use the bass clef.
 
 This will prompt for:
 - title
 - composer"
   (mapconcat #'identity
 	     (list (lilypond-auto-insert-boilerplate)
 		   (lilypond-auto-insert-header)
 		   (lilypond-auto-insert-global)
 		   (lilypond-auto-insert-instruments
 		    "soprano" "alto" "tenor" "bass")
 		   (lilypond-auto-insert-score
 		    "  \\new PianoStaff <<
     \\new Staff <<
       \\soprano
       \\\\
       \\alto
     >>
     \\new Staff \\with {
       \\clef \"bass\"
     }
     <<
       \\tenor
       \\\\
       \\bass
     >>
   >>\n"))
 	     "\n"))
 
 (defvar lilypond-auto-insert-alist
   '((lilypond-auto-insert-solo . "Solo")
     (lilypond-auto-insert-piano . "Piano")
     (lilypond-auto-insert-piano-and-solo . "Piano and Solo Instrument")
     (lilypond-auto-insert-satb . "Choir or Vocal Quartet")
     (lilypond-auto-insert-string-quartet . "String Quartet")
     (lilypond-auto-insert-etc . "Group without Piano")
     (lilypond-auto-insert-piano-etc . "Group with Piano")
     (lilypond-auto-insert-four-part . "Four-part Harmony"))
 
   "Alist of instrumentations used by `lilypond-auto-insert'.
 
 To add your own:
     (add-to-list 'lilypond-auto-insert-alist
 		 '(my-lilypond-insert-function . \"Description\"))")
 
 ;;;###autoload
 (defun lilypond-auto-insert ()
   "Automatically insert lilypond in a fresh buffer.
 
 This prompts from a list of common instrumentations in
 `lilypond-auto-insert-alist'.  You will also be prompted for
 other information such as title, composer, and list of
 instruments if needed."
   (interactive)
   (let ((choice
 	 (completing-read "Instrumentation: "
 			  (mapcar #'cdr lilypond-auto-insert-alist))))
     (insert
      (funcall (car (rassoc choice lilypond-auto-insert-alist))))
     (when (equal major-mode 'LilyPond-mode)
       (indent-region (point-min) (point-max)))))
 
 ;;;###autoload
 (defun lilypond-auto-insert-on-empty-buffer ()
   "Call `lilypond-auto-insert' in an empty buffer.
 
 Useful if added to `LilyPond-mode-hook'."
   (when (= (point-min) (point-max))
     (lilypond-auto-insert)))
 
 (provide 'lilypond-auto-insert)
 ;;; lilypond-auto-insert.el ends here