From: Han-Wen Nienhuys Date: Sun, 7 Apr 2002 10:55:53 +0000 (+0000) Subject: '' X-Git-Tag: release/1.5.51~8 X-Git-Url: https://git.donarmstrong.com/?a=commitdiff_plain;h=34a25e157a46ea77e1933dcd47bf4ad12e09e7de;p=lilypond.git '' --- diff --git a/ChangeLog b/ChangeLog index 57834be19c..825eb9cd30 100644 --- a/ChangeLog +++ b/ChangeLog @@ -11,11 +11,15 @@ * lilypond-mode.el: Added "2Midi" command -2002-04-05 Han-Wen - +2002-04-06 Chris Jackson - * 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 * mf/cmbase.mf: remove file. -- do without s and z signs for now. diff --git a/lily/grob-interface.cc b/lily/grob-interface.cc index dd1b1e9409..283a49fe83 100644 --- a/lily/grob-interface.cc +++ b/lily/grob-interface.cc @@ -6,7 +6,6 @@ Protected_scm all_ifaces; - void add_interface (const char * symbol, const char * descr, const char * vars) diff --git a/lily/grob.cc b/lily/grob.cc index 7daa21f1d4..ea6fc27b5b 100644 --- a/lily/grob.cc +++ b/lily/grob.cc @@ -957,7 +957,7 @@ IMPLEMENT_TYPE_P (Grob, "ly-grob?"); 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"); diff --git a/lily/item.cc b/lily/item.cc index c40c5adba2..7a2f8fb565 100644 --- a/lily/item.cc +++ b/lily/item.cc @@ -199,4 +199,4 @@ unsmob_item (SCM s ) ADD_INTERFACE(Item, "item-interface", "", - "visibility-lambda breakable") + "no-spacing-rods visibility-lambda breakable") diff --git a/lily/piano-pedal-engraver.cc b/lily/piano-pedal-engraver.cc index 4afd70a14a..d3b2789819 100644 --- a/lily/piano-pedal-engraver.cc +++ b/lily/piano-pedal-engraver.cc @@ -7,9 +7,6 @@ Chris Jackson - extended to support bracketed pedals. - - TODO: support for __| |__ or __| Ped instead of ___/\__ for pedal up-down - */ #include "engraver.hh" @@ -58,6 +55,7 @@ private: 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 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(); @@ -291,10 +289,14 @@ Piano_pedal_engraver::create_bracket_grobs (Pedal_info *p, SCM pedaltype) 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; @@ -308,8 +310,14 @@ Piano_pedal_engraver::create_bracket_grobs (Pedal_info *p, SCM pedaltype) 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. @@ -319,7 +327,7 @@ Piano_pedal_engraver::create_bracket_grobs (Pedal_info *p, SCM pedaltype) 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_); diff --git a/lily/stem-engraver.cc b/lily/stem-engraver.cc index 37f8ac7a8b..98d9823249 100644 --- a/lily/stem-engraver.cc +++ b/lily/stem-engraver.cc @@ -54,11 +54,13 @@ Stem_engraver::acknowledge_grob (Grob_info i) 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 (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")); diff --git a/lily/system.cc b/lily/system.cc index d4e8194132..4608d21a56 100644 --- a/lily/system.cc +++ b/lily/system.cc @@ -546,4 +546,4 @@ grob has a Line_of_score as both X and Y reference point. The 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"); diff --git a/lily/text-spanner.cc b/lily/text-spanner.cc index 5187a0658e..cb24ad3fb1 100644 --- a/lily/text-spanner.cc +++ b/lily/text-spanner.cc @@ -172,7 +172,7 @@ Text_spanner::brew_molecule (SCM smob) 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 ()) @@ -202,25 +202,13 @@ Text_spanner::setup_pedal_bracket(Spanner *me) thick *= gh_scm2double (st); } - Drul_array w, broken; + Drul_array broken; Drul_array 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; @@ -240,12 +228,12 @@ Text_spanner::setup_pedal_bracket(Spanner *me) 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); @@ -257,12 +245,6 @@ Text_spanner::setup_pedal_bracket(Spanner *me) 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. { @@ -276,16 +258,19 @@ Text_spanner::setup_pedal_bracket(Spanner *me) 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]) ) ); diff --git a/lilypond-font-lock.el b/lilypond-font-lock.el index 4b5d20b381..9af2d3dcb6 100644 --- a/lilypond-font-lock.el +++ b/lilypond-font-lock.el @@ -9,8 +9,8 @@ ;; 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 @@ -137,12 +137,14 @@ ;; 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 (tenuto) and (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) @@ -169,9 +171,9 @@ (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" ) ( ?\< . "." )( ?\> . ".") ( ?\$ . "." ) ( ?\% . "." ) ( ?\& . "." ) ( ?\* . "." ) ( ?\+ . "." ) diff --git a/lilypond-indent.el b/lilypond-indent.el index 5c2e3be458..5427cc0dfb 100644 --- a/lilypond-indent.el +++ b/lilypond-indent.el @@ -249,27 +249,61 @@ Argument LIM limit." (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)))) @@ -285,9 +319,10 @@ Argument LIM limit." (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 () @@ -314,3 +349,92 @@ Argument LIM limit." (> 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 diff --git a/lilypond-mode.el b/lilypond-mode.el index 592de62018..c4e4bb96a1 100644 --- a/lilypond-mode.el +++ b/lilypond-mode.el @@ -488,6 +488,9 @@ command." (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 diff --git a/scm/backend-documentation-lib.scm b/scm/backend-documentation-lib.scm index ac7ea8f94a..3e6934c554 100644 --- a/scm/backend-documentation-lib.scm +++ b/scm/backend-documentation-lib.scm @@ -52,7 +52,7 @@ (let* ((level (if (eq? where 'grob) 3 2)) (name (car interface)) (desc (cadr interface)) - (props (caddr interface)) + (props (sort (caddr interface) symbol