1 ;;; mmm-region.el --- Manipulating and behavior of MMM submode regions
3 ;; Copyright (C) 2000 by Michael Abraham Shulman
5 ;; Author: Michael Abraham Shulman <viritrilbia@users.sourceforge.net>
6 ;; Version: $Id: mmm-region.el,v 1.38 2003/06/19 11:24:04 viritrilbia Exp $
10 ;; This file is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
15 ;; This file is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
29 ;; This file provides the functions and variables to create, delete,
30 ;; and inspect submode regions, as well as functions that make them
31 ;; behave like the submode with respect to syntax tables, local maps,
34 ;; See mmm-class.el for functions which scan the buffer and decide
35 ;; where to create regions.
47 ;;{{{ Current Overlays
49 ;; Emacs counts an overlay starting at POS as "at" POS, but not an
50 ;; overlay ending at POS. XEmacs is more sensible and uses beg- and
51 ;; end-stickiness to determine whether an endpoint is within an
52 ;; extent. Here we want to act like XEmacs does.
54 (defsubst mmm-overlay-at (&optional pos type)
55 "Return the highest-priority MMM Mode overlay at POS.
56 See `mmm-included-p' for the values of TYPE."
57 (car (mmm-overlays-at pos type)))
59 (defun mmm-overlays-at (&optional pos type)
60 "Return a list of the MMM overlays at POS, in decreasing priority.
61 See `mmm-included-p' for the values of TYPE."
62 (or pos (setq pos (point)))
66 (and (overlay-get ovl 'mmm)
67 (mmm-included-p ovl pos type)))
68 ;; XEmacs complains about positions outside the buffer
69 (overlays-in (max (1- pos) (point-min))
70 (min (1+ pos) (point-max))))))
72 (defun mmm-included-p (ovl pos &optional type)
73 "Return true if the overlay OVL contains POS.
75 If OVL strictly contains POS, always return true. If OVL starts or
76 ends at POS, return true or false based on the value of TYPE, which
77 should be one of nil, `beg', `end', `none', or `all'.
78 * If TYPE is nil, return true for an overlay starting at POS only if
79 it is beg-sticky, and for one ending at POS only if it is end-sticky.
80 * If TYPE is `beg', return true for any overlay starting at POS but
81 false for any ending at POS.
82 * If TYPE is `end', return true for any overlay ending at POS but
83 false for any starting at POS.
84 * If TYPE is `all', return true for any overlay starting or ending at POS.
85 * If TYPE is `none' \(or any other value), return false for any
86 overlay starting or ending at POS."
87 (let ((beg (overlay-start ovl))
88 (end (overlay-end ovl)))
89 (cond ((and (= beg pos) (= end pos))
90 ;; Do the Right Thing for zero-width overlays
92 ((nil) (and (overlay-get ovl 'beg-sticky)
93 (overlay-get ovl 'end-sticky)))
98 ((nil) (overlay-get ovl 'beg-sticky))
103 ((nil) (overlay-get ovl 'end-sticky))
106 ((and (> end pos) (< beg pos))
109 ;;; `mmm-overlays-in' has been retired as altogether too confusing a
110 ;;; name, when what is really meant is one of the following three:
112 (defun mmm-overlays-containing (start stop)
113 "Return all MMM overlays containing the region START to STOP.
114 The overlays are returned in order of decreasing priority. No
115 attention is paid to stickiness."
119 (and (overlay-get ovl 'mmm)
120 (<= (overlay-start ovl) start)
121 (>= (overlay-end ovl) stop)))
122 (overlays-in (max start (point-min))
123 (min stop (point-max))))))
125 (defun mmm-overlays-contained-in (start stop)
126 "Return all MMM overlays entirely contained in START to STOP.
127 The overlays are returned in order of decreasing priority. No
128 attention is paid to stickiness."
132 (and (overlay-get ovl 'mmm)
133 (>= (overlay-start ovl) start)
134 (<= (overlay-end ovl) stop)))
135 (overlays-in (max start (point-min))
136 (min stop (point-max))))))
138 (defun mmm-overlays-overlapping (start stop)
139 "Return all MMM overlays overlapping the region START to STOP.
140 The overlays are returned in order of decreasing priority. No
141 attention is paid to stickiness."
145 (overlay-get ovl 'mmm))
146 (overlays-in (max start (point-min))
147 (min stop (point-max))))))
149 (defun mmm-sort-overlays (overlays)
150 "Sort OVERLAYS in order of decreasing priority."
151 (sort (copy-list overlays)
152 #'(lambda (x y) (> (or (overlay-get x 'priority) 0)
153 (or (overlay-get y 'priority) 0)))))
156 ;;{{{ Current Submode
158 (defvar mmm-current-overlay nil
159 "What submode region overlay we think we are currently in.
160 May be out of date; call `mmm-update-current-submode' to correct it.")
161 (make-variable-buffer-local 'mmm-current-overlay)
163 (defvar mmm-previous-overlay nil
164 "What submode region overlay we were in just before this one.
165 Set by `mmm-update-current-submode'.")
166 (make-variable-buffer-local 'mmm-previous-overlay)
168 (defvar mmm-current-submode nil
169 "What submode we think we are currently in.
170 May be out of date; call `mmm-update-current-submode' to correct it.")
171 (make-variable-buffer-local 'mmm-current-submode)
173 (defvar mmm-previous-submode nil
174 "What submode we were in just before this one.
175 Set by `mmm-update-current-submode'.")
176 (make-variable-buffer-local 'mmm-previous-submode)
178 (defun mmm-update-current-submode (&optional pos)
179 "Update current and previous position variables to POS, or point.
180 Return non-nil if the current region changed.
182 Also deletes overlays that ought to evaporate because their delimiters
184 (mapc #'delete-overlay
185 (remove-if #'(lambda (ovl)
186 (or (not (eq (overlay-get ovl 'mmm-evap) 'front))
187 (overlay-buffer (overlay-get ovl 'front))))
188 (mmm-overlays-at pos)))
189 (let ((ovl (mmm-overlay-at pos)))
190 (if (eq ovl mmm-current-overlay)
192 (setq mmm-previous-overlay mmm-current-overlay
193 mmm-previous-submode mmm-current-submode)
194 (setq mmm-current-overlay ovl
195 mmm-current-submode (if ovl (overlay-get ovl 'mmm-mode)))
198 ;; This function is, I think, mostly for hacking font-lock.
199 (defun mmm-set-current-submode (mode &optional pos)
200 "Set the current submode to MODE and the current region to whatever
201 region of that mode is present at POS, or nil if none."
202 (setq mmm-previous-overlay mmm-current-overlay
203 mmm-previous-submode mmm-current-submode)
204 (setq mmm-current-submode mode
206 (find-if #'(lambda (ovl)
207 (eq (overlay-get ovl 'mmm-mode) mode))
208 (mmm-overlays-at (or pos (point)) 'all))))
210 (defun mmm-submode-at (&optional pos type)
211 "Return the submode at POS \(or point), or NIL if none.
212 See `mmm-included-p' for values of TYPE."
213 (let ((ovl (mmm-overlay-at pos type)))
214 (if ovl (overlay-get ovl 'mmm-mode))))
217 ;;{{{ Delimiter Matching and Boundaries
219 (defun mmm-match-front (ovl)
220 "Return non-nil if the front delimiter of OVL matches as it should.
221 Sets the match data to the front delimiter, if it is a regexp.
222 Otherwise, calls it as a function with point at the beginning of the
223 front delimiter overlay \(i.e. where the front delimiter ought to
224 start) and one argument being the region overlay. The function should
225 return non-nil if the front delimiter matches correctly, and set the
226 match data appropriately."
227 (let* ((front-ovl (overlay-get ovl 'front))
228 (front (if front-ovl (overlay-get front-ovl 'match))))
231 (goto-char (overlay-start front-ovl))
236 (funcall front ovl))))))
238 (defun mmm-match-back (ovl)
239 "Return non-nil if the back delimiter of OVL matches as it should.
240 Sets the match data to the back delimiter, if it is a regexp.
241 Otherwise, calls it as a function with point at the beginning of the
242 back delimiter overlay \(i.e. where the back delimiter ought to start)
243 and one argument being the region overlay. The function should return
244 non-nil if the back delimiter matches correctly, and set the match
246 (let* ((back-ovl (overlay-get ovl 'back))
247 (back (if back-ovl (overlay-get back-ovl 'match))))
250 (goto-char (overlay-start back-ovl))
255 (funcall back ovl))))))
257 (defun mmm-front-start (ovl)
258 "Return the position at which the front delimiter of OVL starts."
259 (let ((front (overlay-get ovl 'front)))
260 ;; Overlays which have evaporated become "overlays in no buffer"
261 (if (and front (overlay-buffer front))
262 (overlay-start front)
263 (overlay-start ovl))))
265 (defun mmm-back-end (ovl)
266 "Return the position at which the back delimiter of OVL ends."
267 (let ((back (overlay-get ovl 'back)))
268 ;; Overlays which have evaporated become "overlays in no buffer"
269 (if (and back (overlay-buffer back))
275 ;; CREATION & DELETION
276 ;;{{{ Make Submode Regions
278 (defun mmm-valid-submode-region (submode beg end)
279 "Check if the region between BEG and END is valid for SUBMODE.
280 This region must be entirely contained within zero or more existing
281 submode regions, none of which start or end inside it, and it must be
282 a valid child of the highest-priority of those regions, if any.
283 Signals errors, returns `t' if no error."
284 ;; First check if the placement is valid. Every existing region
285 ;; that overlaps this one must contain it in its entirety.
286 (let ((violators (set-difference
287 (mmm-overlays-overlapping beg end)
288 (mmm-overlays-containing beg end))))
290 (signal 'mmm-subregion-invalid-placement
292 ;; Now check if it is inside a valid parent
293 (let ((parent-mode (mmm-submode-at beg 'beg)))
295 ;; TODO: Actually check parents here. For present purposes,
296 ;; we just make sure we aren't putting a submode inside one
297 ;; of the same type. Actually, what we should really be
298 ;; doing is checking classes/names of regions, not just the
300 (eq submode parent-mode)
301 (signal 'mmm-subregion-invalid-parent
302 (list parent-mode))))
305 (defun* mmm-make-region
306 (submode beg end &key face
307 front back (evaporation 'front)
308 delimiter-mode front-face back-face
310 (match-front "") (match-back "")
311 (beg-sticky t) (end-sticky t)
314 "Make a submode region from BEG to END of SUBMODE.
316 BEG and END are buffer positions or markers with BEG <= END \(although
317 see EVAPORATION below). SUBMODE is a major mode function or a valid
318 argument to `mmm-modename->function'. FACE is a valid display face.
320 FRONT and BACK specify the positions of the front and back delimiters
321 for this region, if any. If FRONT is a buffer position or marker, the
322 front delimiter runs from it to BEG. FRONT can also be a two-element
323 list \(FRONT-BEG FRONT-END) specifying the exact position of the front
324 delimiter. One must have FRONT-BEG < FRONT-END <= BEG.
326 Similarly, BACK may be a buffer position or marker, in which case the
327 back delimiter runs from END to BACK. BACK can also be a two-element
328 list \(BACK-BEG BACK-END) specifying the exact position, in which case
329 we must have END <= BACK-BEG < BACK-END.
331 EVAPORATION specifies under what conditions this submode region should
333 * If `nil', the region never disappears. This can cause serious
334 problems when using cut-and-paste and is not recommended.
335 * If the value is t, the region disappears whenever it has zero
336 length. This is recommended for manually created regions used for
337 temporary editing convenience.
338 * If the value is `front', the region will disappear whenever the text
339 in its front delimiter disappears, that is, whenever the overlay
340 which marks its front delimiter has zero width.
341 The default value is `front'. However, if the parameter FRONT is nil,
342 then this makes no sense, so the default becomes `t'. Note that if
343 EVAPORATION is `t', then an error is signalled if BEG = END.
345 MATCH-FRONT \(resp. MATCH-BACK) is a regexp or function to match the
346 correct delimiters, see `mmm-match-front' \(resp. `mmm-match-back').
347 It is ignored if FRONT \(resp. BACK) is nil. At present these are not
350 DELIMITER-MODE specifies the major mode to use for delimiter regions.
351 A `nil' value means they remain in the primary mode.
353 FACE, FRONT-FACE, and BACK-FACE, are faces to use for the region, the
354 front delimiter, and the back delimiter, respectively, under high
355 decoration \(see `mmm-submode-decoration-level').
357 BEG-STICKY and END-STICKY determine whether the front and back of the
358 region, respectively, are sticky with respect to new insertion. The
361 NAME is a string giving the \"name\" of this submode region. Submode
362 regions with the same name are considered part of the same code
363 fragment and formatted accordingly.
365 DISPLAY-NAME is a string to display in the mode line when point is in
366 this submode region. If nil or not given, the name associated with
367 SUBMODE is used. In delimiter regions, \"--\" is shown.
369 CREATION-HOOK should be a function to run after the region is created,
370 with point at the start of the new region."
371 ;; Check placement of region and delimiters
372 (unless (if (eq evaporation t)
375 (signal 'mmm-subregion-invalid-placement (list beg end)))
377 (unless (listp front)
378 (setq front (list front beg)))
379 (unless (and (< (car front) (cadr front))
380 (<= (cadr front) beg))
381 (signal 'mmm-subregion-invalid-placement front)))
384 (setq back (list end back)))
385 (unless (and (< (car back) (cadr back))
387 (signal 'mmm-subregion-invalid-placement back)))
388 (setq submode (mmm-modename->function submode))
389 ;; Check embedding in existing regions
390 (mmm-valid-submode-region submode beg end)
393 (mmm-update-mode-info submode))
394 (and (not front) (eq evaporation 'front) (setq evaporation t))
396 (mmm-make-overlay submode beg end name face beg-sticky end-sticky
397 (or (eq evaporation t) nil) display-name)))
398 ;; Save evaporation type for checking later
399 (overlay-put region-ovl 'mmm-evap evaporation)
400 ;; Calculate priority to supersede anything already there.
401 (overlay-put region-ovl 'priority (length (mmm-overlays-at beg)))
402 ;; Make overlays for the delimiters, with appropriate pointers.
405 (mmm-make-overlay delimiter-mode (car front) (cadr front)
406 nil front-face nil nil t "--" t)))
407 (overlay-put region-ovl 'front front-ovl)
408 (overlay-put front-ovl 'region region-ovl)
409 (overlay-put front-ovl 'match match-front)))
412 (mmm-make-overlay delimiter-mode (car back) (cadr back)
413 nil back-face nil nil t "--" t)))
414 (overlay-put region-ovl 'back back-ovl)
415 (overlay-put back-ovl 'region region-ovl)
416 (overlay-put back-ovl 'match match-back)))
417 ;; Update everything and run all the hooks
419 (goto-char (overlay-start region-ovl))
420 (mmm-set-current-submode submode)
421 (mmm-set-local-variables submode)
422 (mmm-run-submode-hook submode)
424 (funcall creation-hook))
425 (mmm-save-changed-local-variables region-ovl submode))
426 (setq mmm-previous-submode submode
427 mmm-previous-overlay region-ovl)
428 (mmm-update-submode-region)
431 (defun mmm-make-overlay (submode beg end name face beg-sticky end-sticky evap
432 &optional display-name delim)
433 "Internal function to make submode overlays.
434 Does not handle delimiters. Use `mmm-make-region'."
435 (let ((ovl (make-overlay beg end nil (not beg-sticky) end-sticky)))
437 #'(lambda (pair) (overlay-put ovl (car pair) (cadr pair)))
438 `((mmm t) ; Mark all submode overlays
440 ,@(if delim '((delim t)) nil)
442 ;; Have to be careful to make new list structure here
443 ,(list* (list 'font-lock-cache-state nil)
444 (list 'font-lock-cache-position (make-marker))
446 (cdr (assq submode mmm-region-saved-locals-defaults)))))
448 (display-name ,display-name)
449 ;; Need to save these, because there's no way of accessing an
450 ;; overlay's official "front-advance" parameter once it's created.
451 (beg-sticky ,beg-sticky)
452 (end-sticky ,end-sticky)
453 ;; These have special meaning to Emacs
454 (,mmm-evaporate-property ,evap)
455 (face ,(mmm-get-face face submode delim))
459 (defun mmm-get-face (face submode &optional delim)
460 (cond ((= mmm-submode-decoration-level 0) nil)
461 ((and (= mmm-submode-decoration-level 2) face) face)
462 (delim 'mmm-delimiter-face)
463 (submode 'mmm-default-submode-face)))
468 ;; See also `mmm-clear-current-region'.
470 (defun mmm-clear-overlays (&optional start stop strict)
471 "Clears all MMM overlays overlapping START and STOP.
472 If STRICT, only clear those entirely included in that region."
473 (mapcar #'delete-overlay
475 (mmm-overlays-contained-in (or start (point-min))
476 (or stop (point-max)))
477 (mmm-overlays-overlapping (or start (point-min))
478 (or stop (point-max)))))
479 (mmm-update-submode-region))
486 (defun mmm-update-mode-info (mode &optional force)
487 "Save the global-saved and buffer-saved variables for MODE.
488 Global saving is done on properties of the symbol MODE and buffer
489 saving in `mmm-buffer-saved-locals'. This function must be called for
490 both the dominant mode and all submodes, in each file. Region-saved
491 variables are initialized from `mmm-region-saved-locals-defaults',
492 which is set here as well. See `mmm-save-local-variables'. If FORCE
493 is non-nil, don't quit if the info is already there."
494 (let ((buffer-entry (assq mode mmm-buffer-saved-locals))
495 (region-entry (assq mode mmm-region-saved-locals-defaults))
496 global-vars buffer-vars region-vars
497 ;; kludge for XEmacs 20
498 (html-helper-build-new-buffer nil))
499 (unless (and (not force)
500 (get mode 'mmm-local-variables)
504 (let ((filename (buffer-file-name)))
505 ;; On errors, the temporary buffers don't get deleted, so here
506 ;; we get rid of any old ones that may be hanging around.
507 (when (buffer-live-p (get-buffer mmm-temp-buffer-name))
509 (set-buffer (get-buffer mmm-temp-buffer-name))
510 (set-buffer-modified-p nil)
511 (kill-buffer (current-buffer))))
512 ;; Now make a new temporary buffer.
513 (set-buffer (mmm-make-temp-buffer (current-buffer)
514 mmm-temp-buffer-name))
515 ;; Handle stupid modes that need the file name set
516 (if (memq mode mmm-set-file-name-for-modes)
517 (setq buffer-file-name filename)))
519 (when (featurep 'font-lock)
520 ;; XEmacs doesn't have global-font-lock-mode (or rather, it
521 ;; has nothing but global-font-lock-mode).
523 ;; Code copied from font-lock.el to detect when font-lock
524 ;; should be on via global-font-lock-mode.
525 (and (or font-lock-defaults
526 (assq major-mode font-lock-defaults-alist)
527 (assq major-mode font-lock-keywords-alist))
528 (or (eq font-lock-global-modes t)
529 (if (eq (car-safe font-lock-global-modes) 'not)
530 (not (memq major-mode
531 (cdr font-lock-global-modes)))
532 (memq major-mode font-lock-global-modes)))))
533 ;; Don't actually fontify in the temp buffer, but note
534 ;; that we should fontify when we use this mode.
535 (put mode 'mmm-font-lock-mode t))
536 ;; Get the font-lock variables
537 (when mmm-font-lock-available-p
538 ;; To fool `font-lock-add-keywords'
539 (let ((font-lock-mode t))
540 (mmm-set-font-lock-defaults)))
541 ;; These can't be in the local variables list, because we
542 ;; replace their actual values, but we want to use their
543 ;; original values elsewhere.
544 (unless (and mmm-xemacs (= emacs-major-version 20))
545 ;; XEmacs 20 doesn't have this variable. This effectively
546 ;; prevents the MMM font-lock support from working, but we
547 ;; just ignore it and go on, to prevent an error message.
548 (put mode 'mmm-fontify-region-function
549 font-lock-fontify-region-function))
550 (put mode 'mmm-beginning-of-syntax-function
551 font-lock-beginning-of-syntax-function))
553 (setq global-vars (mmm-get-locals 'global)
554 buffer-vars (mmm-get-locals 'buffer)
555 region-vars (mmm-get-locals 'region))
556 (put mode 'mmm-mode-name mode-name)
557 (set-buffer-modified-p nil)
558 (kill-buffer (current-buffer)))
559 (put mode 'mmm-local-variables global-vars)
561 (setcdr buffer-entry buffer-vars)
562 (push (cons mode buffer-vars) mmm-buffer-saved-locals))
564 (setcdr region-entry region-vars)
565 (push (cons mode region-vars)
566 mmm-region-saved-locals-defaults)))))
571 (defun mmm-update-submode-region ()
572 "Update all MMM properties correctly for the current position.
573 This function and those it calls do the actual work of setting the
574 different keymaps, syntax tables, local variables, etc. for submodes."
575 (when (mmm-update-current-submode)
576 (mmm-save-changed-local-variables mmm-previous-overlay
577 mmm-previous-submode)
578 (let ((mode (or mmm-current-submode mmm-primary-mode)))
579 (mmm-update-mode-info mode)
580 (mmm-set-local-variables mode)
581 (mmm-enable-font-lock mode))
583 (dolist (func (if mmm-current-overlay
584 (overlay-get mmm-current-overlay 'entry-hook)
585 mmm-primary-mode-entry-hook))
586 (ignore-errors (funcall func)))))
588 (defun mmm-add-hooks ()
589 ;(make-local-hook 'post-command-hook)
590 (add-hook 'post-command-hook 'mmm-update-submode-region nil 'local))
592 (defun mmm-remove-hooks ()
593 (remove-hook 'post-command-hook 'mmm-update-submode-region 'local))
596 ;;{{{ Local Variables
598 (defun mmm-get-local-variables-list (type mode)
599 "Filter `mmm-save-local-variables' to match TYPE and MODE.
600 Return a list \(VAR ...). In some cases, VAR will be a cons cell
601 \(GETTER . SETTER) -- see `mmm-save-local-variables'."
602 (mapcan #'(lambda (element)
603 (and (if (and (consp element)
606 (eq (cadr element) type)
608 (if (and (consp element)
610 (not (eq (caddr element) t)))
611 (if (functionp (caddr element))
612 (funcall (caddr element))
613 (member mode (caddr element)))
615 (list (if (consp element) (car element) element))))
616 mmm-save-local-variables))
618 (defun mmm-get-locals (type)
619 "Get the local variables and values for TYPE from this buffer.
620 Return \((VAR VALUE) ...). In some cases, VAR will be of the form
621 \(GETTER . SETTER) -- see `mmm-save-local-variables'."
622 (mapcan #'(lambda (var)
624 `((,var ,(funcall (car var))))
626 ;; This seems logical, but screws things up.
627 ;;(local-variable-p var)
628 `((,var ,(symbol-value var))))))
629 (mmm-get-local-variables-list type major-mode)))
631 (defun mmm-get-saved-local (mode var)
632 "Get the value of the local variable VAR saved for MODE, if any."
633 (cadr (assq var (mmm-get-saved-local-variables mode))))
635 (defun mmm-set-local-variables (mode)
636 "Set all the local variables saved for MODE.
637 Looks up both global, buffer, and region saves."
638 (mapcar #'(lambda (var)
639 ;; (car VAR) may be (GETTER . SETTER)
640 (if (consp (car var))
641 (funcall (cdar var) (cadr var))
642 (make-local-variable (car var))
643 (set (car var) (cadr var))))
644 (mmm-get-saved-local-variables mode)))
646 (defun mmm-get-saved-local-variables (mode)
647 (append (get mode 'mmm-local-variables)
648 (cdr (assq mode mmm-buffer-saved-locals))
649 (let ((ovl (mmm-overlay-at (point))))
651 (overlay-get ovl 'mmm-local-variables)
652 mmm-region-saved-locals-for-dominant))))
654 (defun mmm-save-changed-local-variables (ovl mode)
655 "Save by-buffer and by-region variables for OVL and MODE.
656 Called when we move to a new submode region, with OVL and MODE the
657 region and mode for the previous position."
658 (let ((buffer-vars (cdr (assq (or mode mmm-primary-mode)
659 mmm-buffer-saved-locals)))
661 (overlay-get ovl 'mmm-local-variables)
662 mmm-region-saved-locals-for-dominant))
666 ;; (car VAR) may be (GETTER . SETTER)
667 (if (consp (car var))
669 (symbol-value (car var)))))))
670 (mapc set-local-value buffer-vars)
671 (mapc set-local-value region-vars)))
673 (defun mmm-clear-local-variables ()
674 "Clear all buffer- and region-saved variables for current buffer."
675 (setq mmm-buffer-saved-locals ()
676 mmm-region-saved-locals-defaults ()
677 mmm-region-saved-locals-for-dominant ()))
682 ;;{{{ Enable Font Lock
684 (defun mmm-enable-font-lock (mode)
685 "Turn on font lock if it is not already on and MODE enables it."
686 (mmm-update-mode-info mode)
687 (and mmm-font-lock-available-p
689 (get mode 'mmm-font-lock-mode)
692 (defun mmm-update-font-lock-buffer ()
693 "Turn on font lock iff any mode in the buffer enables it."
694 (when mmm-font-lock-available-p
695 (if (some #'(lambda (mode)
696 (get mode 'mmm-font-lock-mode))
697 (cons mmm-primary-mode
698 (mapcar #'(lambda (ovl)
699 (overlay-get ovl 'mmm-mode))
700 (mmm-overlays-overlapping
701 (point-min) (point-max)))))
703 (font-lock-mode 0))))
705 (defun mmm-refontify-maybe (&optional start stop)
706 "Re-fontify from START to STOP, or entire buffer, if enabled."
709 (font-lock-fontify-region (or start (point-min))
710 (or stop (point-max)))
711 (font-lock-fontify-buffer))))
714 ;;{{{ Get Submode Regions
716 ;;; In theory, these are general functions that have nothing to do
717 ;;; with font-lock, but they aren't used anywhere else, so we might as
718 ;;; well have them close.
720 (defun mmm-submode-changes-in (start stop)
721 "Return a list of all submode-change positions from START to STOP.
722 The list is sorted in order of increasing buffer position."
723 (sort (remove-duplicates
725 (mapcan #'(lambda (ovl)
726 `(,(overlay-start ovl)
728 (mmm-overlays-overlapping start stop))))
731 (defun mmm-regions-in (start stop)
732 "Return a list of regions of the form (MODE BEG END) whose disjoint
733 union covers the region from START to STOP, including delimiters."
735 (maplist #'(lambda (pos-list)
737 (list (or (mmm-submode-at (car pos-list) 'beg)
739 (car pos-list) (cadr pos-list))))
740 (mmm-submode-changes-in start stop))))
741 (setcdr (last regions 2) nil)
745 (defun mmm-regions-alist (start stop)
746 "Return a list of lists of the form \(MODE . REGIONS) where REGIONS
747 is a list of elements of the form \(BEG END). The disjoint union all
748 of the REGIONS covers START to STOP."
749 (let ((regions (mmm-regions-in start stop)))
750 (mapcar #'(lambda (mode)
752 (mapcan #'(lambda (region)
753 (if (eq mode (car region))
754 (list (cdr region))))
757 (remove-duplicates (mapcar #'car regions)))))
760 ;;{{{ Fontify Regions
762 (defun mmm-fontify-region (start stop &optional loudly)
763 "Fontify from START to STOP keeping track of submodes correctly."
765 (message "Fontifying %s with submode regions..." (buffer-name)))
766 ;; Necessary to catch changes in font-lock cache state and position.
767 (mmm-save-changed-local-variables
768 mmm-current-overlay mmm-current-submode)
769 ;; For some reason `font-lock-fontify-block' binds this to nil, thus
770 ;; preventing `mmm-beginning-of-syntax' from doing The Right Thing.
771 ;; I don't know why it does this, but let's undo it here.
772 (let ((font-lock-beginning-of-syntax-function 'mmm-beginning-of-syntax))
773 (mapc #'(lambda (elt)
774 (when (get (car elt) 'mmm-font-lock-mode)
775 (mmm-fontify-region-list (car elt) (cdr elt))))
776 (mmm-regions-alist start stop)))
777 ;; With jit-lock, this causes blips in the mode line and menus.
778 ;; Shouldn't be necessary here, since it's in post-command-hook too.
779 ;;(mmm-update-submode-region)
780 (when loudly (message nil)))
782 (defun mmm-fontify-region-list (mode regions)
783 "Fontify REGIONS, each like \(BEG END), in mode MODE."
785 (let (;(major-mode mode)
786 (func (get mode 'mmm-fontify-region-function)))
787 (mapc #'(lambda (reg)
788 (goto-char (car reg))
789 ;; Here we do the same sort of thing that
790 ;; `mmm-update-submode-region' does, but we force it
791 ;; to use a specific mode, and don't save anything,
792 ;; fontify, or change the mode line.
793 (mmm-set-current-submode mode)
794 (mmm-set-local-variables mode)
795 (funcall func (car reg) (cadr reg) nil)
796 ;; Catch changes in font-lock cache.
797 (mmm-save-changed-local-variables
798 mmm-current-overlay mmm-current-submode))
802 ;;{{{ Beginning of Syntax
804 (defun mmm-beginning-of-syntax ()
806 (let ((ovl (mmm-overlay-at (point)))
807 (func (get (or mmm-current-submode mmm-primary-mode)
808 'mmm-beginning-of-syntax-function)))
809 (max (if ovl (overlay-start ovl) (point-min))
810 (if func (progn (funcall func) (point)) (point-min))
815 (provide 'mmm-region)
817 ;;; mmm-region.el ends here