* lilypond-mode.el: Added "2Midi" command
-2002-04-05 Han-Wen <hanwen@cs.uu.nl>
-
+2002-04-06 Chris Jackson <chris@fluffhouse.org.uk>
- * patches from Chris Jackson for pedals.
+ * lilypond-indent.el: Support for blinking of matching parentheses
+
+ * lilypond-font-lock.el: Fix fontification of closing > on its own line
+
+ * pedal patches.
+2002-04-05 Han-Wen <hanwen@cs.uu.nl>
* mf/cmbase.mf: remove file. -- do without s and z signs for now.
Protected_scm all_ifaces;
-
void add_interface (const char * symbol,
const char * descr,
const char * vars)
ADD_INTERFACE (Grob, "grob-interface",
"All grobs support this",
"X-offset-callbacks Y-offset-callbacks X-extent-callback molecule cause
-Y-extent-callback molecule-callback font-relative-size extra-offset
-staff-symbol interfaces dependencies no-spacing-rods extra-extent-X causes
-layer extra-extent-Y minimum-extent-X minimum-extent-Y transparent");
+Y-extent-callback molecule-callback extra-offset
+staff-symbol interfaces dependencies extra-extent-X causes
+layer before-line-breaking-callback after-line-breaking-callback extra-extent-Y minimum-extent-X minimum-extent-Y transparent");
ADD_INTERFACE(Item,
"item-interface",
"",
- "visibility-lambda breakable")
+ "no-spacing-rods visibility-lambda breakable")
Chris Jackson <chris@fluffhouse.org.uk> - extended to support
bracketed pedals.
-
- TODO: support for __| |__ or __| Ped instead of ___/\__ for pedal up-down
-
*/
#include "engraver.hh"
Spanner *previous_p_ [4]; // Record a stack of the current pedal spanners, so if more than one pedal
int nspanners_i; // occurs simultaneously then extra space can be added between them.
+ Drul_array<SCM> edge_width_drul_; // Left and right flare widths of a \___/, as specified by the grob property edge-width.
void create_text_grobs (Pedal_info *p, SCM pedaltype);
void create_bracket_grobs (Pedal_info *p, SCM pedaltype);
void typeset_all();
p->bracket_p_->set_bound (RIGHT, unsmob_grob(get_property ("currentMusicalColumn")));
- // Set a property so that the molecule-creating function will know whether the right edge should be flared ___/
- p->bracket_p_->set_grob_property("right-widen", gh_bool2scm((bool) p->req_l_drul_[START]) );
+ // Set properties so that the molecule-creating function will know whether the right edge should be flared ___/
+ SCM eleft = ly_car ( p->bracket_p_->get_grob_property("edge-width") );
+ SCM eright = ( (bool) p->req_l_drul_[START] ?
+ edge_width_drul_[RIGHT] :
+ gh_double2scm(0) );
+ p->bracket_p_->set_grob_property("edge-width", gh_cons ( eleft, eright ) );
add_bound_item (p->line_spanner_, p->bracket_p_->get_bound (RIGHT));
-
+
p->finished_bracket_p_ = p->bracket_p_;
p->bracket_p_ = 0;
p->current_bracket_req_ = 0;
p->bracket_p_ = new Spanner (get_property ("PianoPedalBracket"));
- // Set a property so that the molecule-creating function will know whether the left edge should be flared \___
- p->bracket_p_->set_grob_property("left-widen", gh_bool2scm((bool) p->req_l_drul_[STOP]) );
+ // Set properties so that the molecule-creating function will know whether the left edge should be flared \___
+ edge_width_drul_[LEFT] = ly_car ( p->bracket_p_->get_grob_property("edge-width") );
+ edge_width_drul_[RIGHT] = ly_cdr ( p->bracket_p_->get_grob_property("edge-width") );
+ SCM eleft = ( (bool) p->req_l_drul_[STOP] ?
+ edge_width_drul_[LEFT] :
+ gh_double2scm(0) );
+ SCM eright = gh_double2scm(0);
+ p->bracket_p_->set_grob_property("edge-width", gh_cons ( eleft, eright ) );
// Set this property for 'mixed style' pedals, Ped._______/\ ,
// so the molecule function will shorten the ____ line by the length of the Ped. text.
gh_bool2scm(false));
if (p->item_p_)
p->bracket_p_->set_parent (p->item_p_, Y_AXIS);
-
+
p->bracket_p_->set_bound (LEFT, unsmob_grob (get_property ("currentMusicalColumn")));
Axis_group_interface::add_element (p->line_spanner_, p->bracket_p_);
if (Rhythmic_head::stem_l (h))
return;
- /*
- We take the duration-log of the head; this is because
- auto-tieing does strange things with the rhythmics.
- */
- int duration_log =gh_scm2int (h->get_grob_property ("duration-log"));
+ /* Reverted to the old method so chord tremolos work again. /MB
+ */
+ int duration_log = 0;
+ Rhythmic_req *rhythmic_req = dynamic_cast <Rhythmic_req *> (i.music_cause ());
+ if (rhythmic_req)
+ duration_log = unsmob_duration (rhythmic_req->get_mus_property ("duration"))-> duration_log ();
+
if (!stem_p_)
{
stem_p_ = new Item (get_property ("Stem"));
Paper_score contains one grob of this type. Control enters the
Grob dependency calculation from this single Line_of_score
object.",
- "between-system-string spacing-procedure before-line-breaking-callback after-line-breaking-callback all-elements columns");
+ "between-system-string spacing-procedure all-elements columns");
m.add_at_edge (X_AXIS, RIGHT, edge_line[LEFT], 0);
if (!line.empty_b ())
m.add_at_edge (X_AXIS, RIGHT, line,
- edge_line[LEFT].empty_b () ? 0 : - thick/2);
+ edge_line[LEFT].empty_b () ? 0 : -thick/2);
if (!edge_line[RIGHT].empty_b ())
m.add_at_edge (X_AXIS, RIGHT, edge_line[RIGHT], -thick/2);
if (!edge[RIGHT].empty_b ())
thick *= gh_scm2double (st);
}
- Drul_array<bool> w, broken;
+ Drul_array<bool> broken;
Drul_array<Real> height, width, shorten, r;
- /*
- FIXME: too many new property names.
- */
SCM pa = me->get_grob_property ("if-text-padding");
SCM ew = me->get_grob_property ("edge-width");
SCM eh = me->get_grob_property ("edge-height");
SCM sp = me->get_grob_property ("shorten-pair");
- SCM wl = me->get_grob_property ("left-widen");
- SCM wr = me->get_grob_property ("right-widen");
-
- // Pedal has an angled left edge \__ or an angled right edge __/
- w[LEFT] = w[RIGHT] = false;
- if (gh_boolean_p (wl) )
- w[LEFT] = to_boolean (wl);
- if (gh_boolean_p (wr) )
- w[RIGHT] = to_boolean (wr);
Direction d = LEFT;
Interval e;
width[d] = 0;
height[d] = 0;
shorten[d] = 0;
- if ( w[d] && gh_pair_p (ew) )
+ if ( gh_pair_p (ew) )
width[d] += gh_scm2double (index_cell (ew, d)) * d;
if ( !broken[d] && (gh_pair_p (eh) ) )
- height[d] = gh_scm2double (index_cell (eh, d));
+ height[d] += gh_scm2double (index_cell (eh, d));
if ( gh_pair_p (sp) )
- shorten[d] = gh_scm2double (index_cell (sp, d));
+ shorten[d] += gh_scm2double (index_cell (sp, d));
}
while (flip (&d) != LEFT);
height[LEFT] = 0;
Grob * textbit = me->get_parent(Y_AXIS);
extra_short = padding;
- if (textbit->has_interface(ly_symbol2scm("piano-pedal-interface")))
- // for pretty Ped. scripts.
- {
- e = textbit->extent(textbit, Y_AXIS);
- extra_short += e.length();
- }
if (textbit->has_interface(ly_symbol2scm("text-interface")))
// for plain text, e.g., Sost. Ped.
{
shorten[RIGHT] -= thick;
}
- // Shorten a \____ on the left so that it will touch an adjoining ___/
- shorten[LEFT] += abs(width[LEFT]) * 2 + extra_short ;
+ shorten[LEFT] += extra_short ;
if (broken[LEFT]) {
- shorten[LEFT] -= me->get_broken_left_end_align () ;
- shorten[RIGHT] -= r[RIGHT];
+ shorten[LEFT] -= me->get_broken_left_end_align () ;
+ shorten[RIGHT] += abs(width[RIGHT]) + thick - r[RIGHT];
+ }
+
+ else {
+ // Shorten a ____/ on the right so that it will touch an adjoining \___
+ shorten[RIGHT] += abs(width[LEFT]) + abs(width[RIGHT]) + thick;
+ // Also shorten so that it ends just before the spanned note.
+ shorten[RIGHT] -= (r[LEFT] + r[RIGHT]);
}
- else
- // Shorten bracket on the right so it ends just before the spanned note.
- shorten[RIGHT] += thick - (r[LEFT] + r[RIGHT]);
me->set_grob_property ("edge-height", gh_cons ( gh_double2scm ( height[LEFT] ) ,
gh_double2scm ( height[RIGHT]) ) );
;; Author: 1995-1996 Barry A. Warsaw
;; 1992-1994 Tim Peters
;; Created: Feb 1992
-;; Version: 1.5.47
-;; Last Modified: 26MAR2002
+;; Version: 1.5.50
+;; Last Modified: 6APR2002
;; Keywords: lilypond languages music notation
;; This software is provided as-is, without express or implied
;; highlight bracketing constructs
'("\\([][}{]\\)" 0 font-lock-warning-face t)
-;; these regexps allow angle-brackets to be highlighted,
-;; but leave accented notes, e.g. a b c->, alone
+ ;; these regexps allow angle-brackets to be highlighted when and only when they delimit simultaneous music
+ ;; fontify open < but leave crescendos \< alone
'("[^\\]\\(<\\)" 1 font-lock-warning-face t)
- '("[_^-]\\s-*[-^]\\s-*\\(>\\)" 1 font-lock-warning-face t)
- '("[^\\t\\n _^-]\\s-*\\(>\\)" 1 font-lock-warning-face t)
-
+ ;; fontify the close-brackets in <a b c--> (tenuto) and <a b c-^> (marcato)
+ '("[_^-]\\s-*[-^]\\s-*\\(>\\)" 1 font-lock-warning-face t)
+ ;; but leave a b c-> (accent) alone, accounting for whitespace
+ '("\\([^\\t\\n _^-]\\|^\\)\\s-*\\(>\\)" 2 font-lock-warning-face t)
+ ;; ties ~, slurs (), hairpins \<, \>, end-of-hairpin \!,
'("\\([(~)]\\|\\\\<\\|\\\\!\\|\\\\>\\)" 0 font-lock-builtin-face t)
;; highlight comments (again)
(lambda (x) (modify-syntax-entry
(car x) (cdr x) LilyPond-mode-syntax-table)))
'(( ?\( . "." ) ( ?\) . "." )
- ( ?\[ . "(]" ) ( ?\] . ")[" )
- ( ?\{ . "(}2b" )
- ( ?\} . "){4b" )
+ ( ?\[ . "(]" ) ( ?\] . ")[" ) ;; all the other paren characters are now handled by
+ ( ?\{ . ".2b" ) ;; lily-specific indenting/matching code in lilypond-indent.el
+ ( ?\} . ".4b" )
( ?\< . "." )( ?\> . ".")
( ?\$ . "." ) ( ?\% . "." ) ( ?\& . "." )
( ?\* . "." ) ( ?\+ . "." )
(current-column)))))
-(defconst LilyPond-parens-regexp-alist
- `(("[^\\]<" . "[^ \\n\\t_^-]\\s-*>\\|[_^-]\\s-*[-^]\\s-*>")
- ;; a b c->, a b c^> and a b c_> are not close-angle-brackets, they're accents
- ;; but a b c^-> and a b c^^> are close brackets with tenuto/marcato before them
- ;; also \> and \< are hairpins
- ("{" . "}")))
-
-
-(defconst LilyPond-parens-combined-regexp
- (concat (mapconcat 'car LilyPond-parens-regexp-alist "\\|")
- "\\|"
- (mapconcat 'cdr LilyPond-parens-regexp-alist "\\|")))
+;; Key: Type of bracket (character).
+;; Value: Pair of regexps representing the corresponding open and close bracket"
+;; () are treated specially (need to indent in Scheme but not in music), and []
+;; are handled by the syntax table
-
-(defun LilyPond-beginning-of-containing-sexp ()
- "Move point to the beginning of the deepest parenthesis pair enclosing point."
+(defconst LilyPond-parens-regexp-alist
+ `( ( ?> . ("[^\\]<" . "[^ \\n\\t_^-]\\s-*>\\|[_^-]\\s-*[-^]\\s-*>"))
+ ;; a b c->, a b c^> and a b c_> are not close-angle-brackets, they're accents
+ ;; but a b c^-> and a b c^^> are close brackets with tenuto/marcato before them
+ ;; also \> and \< are hairpins
+ ( ?} . ("{" . "}"))
+ ))
+
+
+(defconst LilyPond-parens-alist
+ `( ( ?< . ?> )
+ ( ?{ . ?} )
+ ( ?\( . ?\) )
+ ))
+
+
+(defun LilyPond-matching-paren (bracket-type)
+ "Returns the open corresponding to the close specified by bracket-type, or vice versa"
+ (cond ( (memq bracket-type (mapcar 'car LilyPond-parens-alist))
+ (cdr (assoc bracket-type LilyPond-parens-alist)) )
+ ( (memq bracket-type (mapcar 'cdr LilyPond-parens-alist))
+ (car (rassoc bracket-type LilyPond-parens-alist)) )
+ nil))
+
+
+(defun LilyPond-beginning-of-containing-sexp (&optional bracket-type slur-paren-p)
+ "Move point to the beginning of the deepest parenthesis pair enclosing point.
+
+If the optional argument bracket-type, a character representing a
+close bracket such as ) or }, is specified, then the parenthesis pairs
+searched are limited to this type.
+
+If the optional argument slur-paren-p is non-nil, then slur
+parentheses () are considered as matching pairs. Otherwise Scheme
+parentheses are considered to be matching pairs, but slurs are not.
+slur-paren-p defaults to nil.
+"
(interactive)
- (let ((level 1))
+ (let ( (level 1)
+ (regexp-alist LilyPond-parens-regexp-alist)
+ (oldpos (point) ) )
(if (LilyPond-inside-scheme-p)
- (setq paren-regexp "(\\|)" inside-scheme t)
- (setq paren-regexp LilyPond-parens-combined-regexp inside-scheme nil))
+ (setq paren-regexp "(\\|)")
+ (if slur-paren-p
+ (setq regexp-alist (cons '( ?\) . ("(" . ")")) regexp-alist)))
+ (if (memq bracket-type (mapcar 'car regexp-alist))
+ (progn (setq paren-regexp (cdr (assoc bracket-type regexp-alist)))
+ (setq paren-regexp (concat (car paren-regexp) "\\|" (cdr paren-regexp))))
+ (setq paren-regexp (concat (mapconcat 'car (mapcar 'cdr regexp-alist) "\\|") "\\|"
+ (mapconcat 'cdr (mapcar 'cdr regexp-alist) "\\|")))))
(while (and (> level 0)
(re-search-backward paren-regexp nil t)
(setq match (char-before (match-end 0))))
(looking-at ".\\s-+<\\|\\({\\|}\\|<\\|>\\|(\\|)\\)<"))
(forward-char 1))))))
(if (looking-at ".<\\|.>") (forward-char 1))
- (if (/= level 1)
+ (if (= level 0)
(point)
- nil)))
+ (progn (goto-char oldpos)
+ nil))))
(defun LilyPond-inside-scheme-p ()
(> level 0))))
t
nil))))
+
+
+;;; Largely taken from the 'blink-matching-open' in lisp/simple.el in
+;;; the Emacs distribution.
+
+(defun LilyPond-blink-matching-open (bracket-type)
+ "Move cursor momentarily to the beginning of the sexp before
+point. In lilypond files this is used for closing ), } and >, whereas the
+builtin 'blink-matching-open' is used for closing ], which is in
+the syntax table"
+ (interactive)
+ (let ( (oldpos (point))
+ (level 0)
+ (mismatch) )
+ (save-restriction
+ (if blink-matching-paren-distance
+ (narrow-to-region (max (point-min)
+ (- (point) blink-matching-paren-distance))
+ oldpos)))
+ (if (memq bracket-type '(?> ?}))
+ ;; < { need to be mutually balanced and nested, so search backwards for both of these bracket types
+ (LilyPond-beginning-of-containing-sexp nil nil)
+ ;; whereas ( ) slurs within music don't, so only need to search for ( )
+ (LilyPond-beginning-of-containing-sexp bracket-type t))
+ (setq blinkpos (point))
+ (setq mismatch
+ (or (null (LilyPond-matching-paren (char-after blinkpos)))
+ (/= (char-after oldpos)
+ (LilyPond-matching-paren (char-after blinkpos)))))
+ (if mismatch (progn (setq blinkpos nil)
+ (message "Mismatched parentheses")))
+ (if blinkpos
+ (if (pos-visible-in-window-p)
+ (and blink-matching-paren-on-screen
+ (sit-for blink-matching-delay))
+ (message
+ "Matches %s"
+ ;; Show what precedes the open in its line, if anything.
+ (if (save-excursion
+ (skip-chars-backward " \t")
+ (not (bolp)))
+ (buffer-substring (progn (beginning-of-line) (point))
+ (1+ blinkpos))
+ ;; Show what follows the open in its line, if anything.
+ (if (save-excursion
+ (forward-char 1)
+ (skip-chars-forward " \t")
+ (not (eolp)))
+ (buffer-substring blinkpos
+ (progn (end-of-line) (point)))
+ ;; Otherwise show the previous nonblank line,
+ ;; if there is one.
+ (if (save-excursion
+ (skip-chars-backward "\n \t")
+ (not (bobp)))
+ (concat
+ (buffer-substring (progn
+ (skip-chars-backward "\n \t")
+ (beginning-of-line)
+ (point))
+ (progn (end-of-line)
+ (skip-chars-backward " \t")
+ (point)))
+ ;; Replace the newline and other whitespace with `...'.
+ "..."
+ (buffer-substring blinkpos (1+ blinkpos)))
+ ;; There is nothing to show except the char itself.
+ (buffer-substring blinkpos (1+ blinkpos))))))))
+ (goto-char oldpos)))
+
+
+(defun LilyPond-electric-close-paren ()
+ "Blink on the matching open paren when a > or ) is inserted"
+ (interactive)
+ (let ((oldpos (point)))
+ (self-insert-command 1)
+ (setq close-char (char-before (point)))
+ (if (and blink-matching-paren
+ (not (LilyPond-inside-string-or-comment-p))
+ (save-excursion (re-search-backward
+ (concat (mapconcat 'cdr (mapcar 'cdr LilyPond-parens-regexp-alist) "\\|") "\\|)") nil t)
+ (eq oldpos (1- (match-end 0)))))
+ (progn (backward-char 1)
+ (LilyPond-blink-matching-open close-char)
+ (forward-char 1)))))
+
+
+;;; TODO:
+;;; emulate show-paren-mode
(define-key LilyPond-mode-map "\C-cn" 'LilyPond-insert-tag-notes)
(define-key LilyPond-mode-map "\C-cs" 'LilyPond-insert-tag-score)
(define-key LilyPond-mode-map "\C-c;" 'comment-region)
+ (define-key LilyPond-mode-map ")" 'LilyPond-electric-close-paren)
+ (define-key LilyPond-mode-map ">" 'LilyPond-electric-close-paren)
+ (define-key LilyPond-mode-map "}" 'LilyPond-electric-close-paren)
)
;;; Menu Support
(let* ((level (if (eq? where 'grob) 3 2))
(name (car interface))
(desc (cadr interface))
- (props (caddr interface))
+ (props (sort (caddr interface) symbol<?))
(docfunc (lambda (pr)
(document-grob-property
pr grob-description )))
projects / lilypond.git / commitdiff