1 ;;; mumamo.el --- Multiple major modes in a buffer
3 ;; Author: Lennart Borgman (lennart O borgman A gmail O com)
5 ;; Created: Fri Mar 09 2007
6 (defconst mumamo:version "0.91") ;;Version:
7 ;; Last-Updated: 2009-10-19 Mon
8 ;; URL: http://OurComments.org/Emacs/Emacs.html
12 ;; Features that might be required by this library:
14 ;; `appmenu', `apropos', `backquote', `button', `bytecomp', `cl',
15 ;; `comint', `compile', `easymenu', `flyspell', `grep', `ido',
16 ;; `ispell', `mail-prsvr', `mlinks', `mm-util', `nxml-enc',
17 ;; `nxml-glyph', `nxml-mode', `nxml-ns', `nxml-outln',
18 ;; `nxml-parse', `nxml-rap', `nxml-util', `ourcomments-util',
19 ;; `recentf', `ring', `rng-dt', `rng-loc', `rng-match',
20 ;; `rng-parse', `rng-pttrn', `rng-uri', `rng-util', `rng-valid',
21 ;; `rx', `sgml-mode', `timer', `tool-bar', `tree-widget',
22 ;; `url-expand', `url-methods', `url-parse', `url-util',
23 ;; `url-vars', `wid-edit', `xmltok'.
26 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
28 ;; This program is free software; you can redistribute it and/or modify
29 ;; it under the terms of the GNU General Public License as published by
30 ;; the Free Software Foundation; either version 3, or (at your option)
33 ;; This program is distributed in the hope that it will be useful,
34 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
35 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
36 ;; GNU General Public License for more details.
38 ;; You should have received a copy of the GNU General Public License
39 ;; along with GNU Emacs; see the file COPYING. If not, write to the
40 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
41 ;; Boston, MA 02110-1301, USA.
44 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
48 ;; In some cases you may find that it is quite hard to write one major
49 ;; mode that does everything for the type of file you want to handle.
50 ;; That is the case for example for a PHP file where there comes
51 ;; useful major modes with Emacs for the html parts, and where you can
52 ;; get a major mode for PHP from other sources (see EmacsWiki for
53 ;; Aaron Hawleys php-mode.el, or the very similar version that comes
56 ;; Using one major mode for the HTML part and another for the PHP part
57 ;; sounds like a good solution. But this means you want to use (at
58 ;; least) two major modes in the same buffer.
60 ;; This file implements just that, support for MUltiple MAjor MOdes
61 ;; (mumamo) in a buffer.
66 ;; The multiple major mode support is turned on by calling special
67 ;; functions which are used nearly the same way as major modes. See
68 ;; `mumamo-defined-multi-major-modes' for more information about those
71 ;; Each such function defines how to take care of a certain mix of
72 ;; major functions in the buffer. We call them "multi major modes".
74 ;; You may call those functions directly (like you can with major mode
75 ;; functions) or you may use them in for example `auto-mode-alist'.
77 ;; You can load mumamo in your .emacs with
79 ;; (require 'mumamo-fun)
81 ;; or you can generate an autoload file from mumamo-fun.el
83 ;; Note that no multi major mode functions are defined in this file.
84 ;; Together with this file comes the file mumamo-fun.el that defines
85 ;; some such functions. All those functions defined in that file are
86 ;; marked for autoload.
90 ;; Thanks to Stefan Monnier for beeing a good and knowledgeable
91 ;; speaking partner for some difficult parts while I was trying to
94 ;; Thanks to RMS for giving me support and ideas about the programming
95 ;; interface. That simplified the code and usage quite a lot.
98 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
100 ;;;; How to add support for a new mix of major modes
102 ;; This is done by creating a new function using
103 ;; `define-mumamo-multi-major-mode'. See that function for more
107 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
109 ;;;; Information for major mode authors
111 ;; There are a few special requirements on major modes to make them
114 ;; - fontification-functions should be '(jit-lock-function). However
115 ;; nxml-mode derivates can work too, see the code for more info.
117 ;; - narrowing should be respected during fontification and
118 ;; indentation when font-lock-dont-widen is non-nil.
121 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
123 ;;;; Information for minor mode authors
125 ;; Some minor modes are written to be specific for the file edited in
126 ;; the buffer and some are written to be specific for a major
127 ;; modes. Others are emulating another editor. Those are probably
128 ;; global, but might still have buffer local values.
130 ;; Those minor modes that are not meant to be specific for a major
131 ;; mode should probably survive changing major mode in the
132 ;; buffer. That is mostly not the case in Emacs today.
134 ;; There are (at least) two type of values for those minor modes that
135 ;; sometimes should survive changing major mode: buffer local
136 ;; variables and functions added locally to hooks.
138 ;; * Some buffer local variables are really that - buffer local. Other
139 ;; are really meant not for the buffer but for the major mode or
140 ;; some minor mode that is local to the buffer.
142 ;; If the buffer local variable is meant for the buffer then it is
143 ;; easy to make them survive changing major mode: just add
145 ;; (put 'VARIABLE 'permanent-local t)
147 ;; to those variables. That will work regardless of the way major
150 ;; If one only wants the variables to survive the major mode change
151 ;; that is done when moving between chunks with different major
152 ;; modes then something different must be used. To make a variable
153 ;; survive this, but not a major mode change for the whole buffer,
154 ;; call any the function `mumamo-make-variable-buffer-permanent':
156 ;; (mumamo-make-variable-buffer-permanent 'VARIABLE)
158 ;; * For functions entered to local hooks use this
160 ;; (put 'FUNSYM 'permanent-local-hook t)
161 ;; (add-hook 'HOOKSYM 'FUNSYM nil t)
163 ;; where HOOKSYM is the hook and FUNSYM is the function.
165 ;; * Some functions that are run in `change-major-mode' and dito
166 ;; after- must be avoided when mumamo changes major mode. The
167 ;; functions to avoid should be listed in
169 ;; `mumamo-change-major-mode-no-nos'
170 ;; `mumamo-after-change-major-mode-no-nos'
172 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
174 ;;;; Comments on code etc:
176 ;; This is yet another way to try to get different major modes for
177 ;; different chunks of a buffer to work. (I borrowed the term "chunk"
178 ;; here from multi-mode.el.) I am aware of two main previous elisp
179 ;; packages that tries to do this, multi-mode.el and mmm-mode.el.
180 ;; (See http://www.emacswiki.org/cgi-bin/wiki/MultipleModes where
181 ;; there are also some other packages mentioned.) The solutions in
182 ;; those are a bit different from the approach here.
184 ;; The idea of doing it the way mumamo does it is of course based on a
185 ;; hope that switching major mode when moving between chunks should be
186 ;; quick. I found that it took from 0 - 62 000 ms, typically 0 - 16
187 ;; 000 ms on a 3ghz cpu. However unfortunately this is not the whole
188 ;; truth. It could take longer time, depending on what is run in the
189 ;; hooks: The major mode specific hook, `after-change-major-mode-hook'
190 ;; and `change-major-mode-hook'.
192 ;; Because it currently may take long enough time switching major mode
193 ;; when moving between chunks to disturb smooth moving around in the
194 ;; buffer I have added a way to let the major mode switching be done
195 ;; after moving when Emacs is idle. This is currently the default, but
196 ;; see the custom variable `mumamo-set-major-mode-delay'.
198 ;; Since the intention is to set up the new major mode the same way as
199 ;; it should have been done if this was a major mode for the whole
200 ;; buffer these hooks must be run. However if this idea is developed
201 ;; further some of the things done in these hooks (like switching on
202 ;; minor modes) could perhaps be streamlined so that switching minor
203 ;; modes off and then on again could be avoided. In fact there is
204 ;; already tools for this in mumamo.el, see the section below named
205 ;; "Information for minor mode authors".
207 ;; Another problem is that the major modes must use
208 ;; `font-lock-fontify-region-function'. Currently the only major
209 ;; modes I know that does not do this are `nxml-mode' and its
212 ;; The indentation is currently working rather ok, but with the price
213 ;; that buffer modified is sometimes set even though there are no
214 ;; actual changes. That seems a bit unnecessary and it could be
215 ;; avoided if the indentation functions for the the various major
216 ;; modes were rewritten so that you could get the indentation that
217 ;; would be done instead of actually doing the indentation. (Or
218 ;; mumamo could do this better, but I do not know how right now.)
220 ;; See also "Known bugs and problems etc" below.
223 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
227 ;; - See the various FIX-ME for possible bugs. See also below.
230 ;;;; Known problems and ideas:
232 ;; - There is no way in Emacs to tell a mode not to change
233 ;; fontification when changing to or from that mode.
237 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
242 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
246 (eval-when-compile (require 'cl))
247 (eval-when-compile (require 'cc-engine))
248 (eval-when-compile (require 'desktop))
249 (eval-when-compile (require 'flyspell))
250 (eval-when-compile (require 'rngalt nil t))
251 (eval-when-compile (require 'nxml-mode nil t))
253 (when (featurep 'nxml-mode)
254 (require 'rng-valid nil t)
255 ;;(require 'rngalt nil t)
257 (eval-when-compile (require 'sgml-mode)) ;; For sgml-xml-mode
258 ;; For `define-globalized-minor-mode-with-on-off':
259 ;;(require 'ourcomments-util)
264 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
265 ;;; rng-valid.el support
267 (defvar rng-get-major-mode-chunk-function nil
268 "Function to use to get major mode chunk.
269 It should take one argument, the position where to get the major
272 This is to be set by multiple major mode frame works, like
275 See also `rng-valid-nxml-major-mode-chunk-function' and
276 `rng-end-major-mode-chunk-function'. Note that all three
277 variables must be set.")
278 (make-variable-buffer-local 'rng-get-major-mode-chunk-function)
279 (put 'rng-get-major-mode-chunk-function 'permanent-local t)
281 (defvar rng-valid-nxml-major-mode-chunk-function nil
282 "Function to use to check if nxml can parse major mode chunk.
283 It should take one argument, the chunk.
285 For more info see also `rng-get-major-mode-chunk-function'.")
286 (make-variable-buffer-local 'rng-valid-nxml-major-mode-chunk-function)
287 (put 'rng-valid-nxml-major-mode-chunk-function 'permanent-local t)
289 (defvar rng-end-major-mode-chunk-function nil
290 "Function to use to get the end of a major mode chunk.
291 It should take one argument, the chunk.
293 For more info see also `rng-get-major-mode-chunk-function'.")
294 (make-variable-buffer-local 'rng-end-major-mode-chunk-function)
295 (put 'rng-end-major-mode-chunk-function 'permanent-local t)
298 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
301 (defvar mumamo-major-mode-indent-line-function nil)
302 (make-variable-buffer-local 'mumamo-major-mode-indent-line-function)
304 (defvar mumamo-buffer-locals-per-major nil)
305 (make-variable-buffer-local 'mumamo-buffer-locals-per-major)
306 (put 'mumamo-buffer-locals-per-major 'permanent-local t)
308 (defvar mumamo-just-changed-major nil
309 "Avoid refontification when switching major mode.
310 Set to t by `mumamo-set-major'. Checked and reset to nil by
311 `mumamo-jit-lock-function'.")
312 (make-variable-buffer-local 'mumamo-just-changed-major)
314 (defvar mumamo-multi-major-mode nil
315 "The function that handles multiple major modes.
316 If this is nil then multiple major modes in the buffer is not
319 Set by functions defined by `define-mumamo-multi-major-mode'.")
320 (make-variable-buffer-local 'mumamo-multi-major-mode)
321 (put 'mumamo-multi-major-mode 'permanent-local t)
323 (defvar mumamo-set-major-running nil
324 "Internal use. Handling of mumamo turn off.")
326 (defun mumamo-chunk-car (chunk prop)
327 (car (overlay-get chunk prop)))
329 (defun mumamo-chunk-cadr (chunk prop)
330 (cadr (overlay-get chunk prop)))
332 ;; (let ((l '(1 2))) (setcar (nthcdr 1 l) 10) l)
334 (defsubst mumamo-chunk-value-set-min (chunk-values min)
335 "In CHUNK-VALUES set min value to MIN.
336 CHUNK-VALUES should have the format return by
337 `mumamo-create-chunk-values-at'."
338 (setcar (nthcdr 0 chunk-values) min))
339 (defsubst mumamo-chunk-value-set-max (chunk-values max)
340 "In CHUNK-VALUES set max value to MAX.
341 See also `mumamo-chunk-value-set-min'."
342 (setcar (nthcdr 1 chunk-values) max))
343 (defsubst mumamo-chunk-value-set-syntax-min (chunk-values min)
344 "In CHUNK-VALUES set min syntax diff value to MIN.
345 See also `mumamo-chunk-value-set-min'."
346 (setcar (nthcdr 3 chunk-values) min))
347 (defsubst mumamo-chunk-value-set-syntax-max (chunk-values max)
348 "In CHUNK-VALUES set max syntax diff value to MAX.
349 See also `mumamo-chunk-value-set-min'."
350 (setcar (nthcdr 3 chunk-values) max))
352 (defsubst mumamo-chunk-value-min (chunk-values)
353 "Get min value from CHUNK-VALUES.
354 See also `mumamo-chunk-value-set-min'."
355 (nth 0 chunk-values))
356 (defsubst mumamo-chunk-value-max (chunk-values)
357 "Get max value from CHUNK-VALUES.
358 See also `mumamo-chunk-value-set-min'."
359 (nth 1 chunk-values))
360 (defsubst mumamo-chunk-value-major (chunk-values)
361 "Get major value from CHUNK-VALUES.
362 See also `mumamo-chunk-value-set-min'."
363 (nth 2 chunk-values))
364 (defsubst mumamo-chunk-value-syntax-min (chunk-values)
365 "Get min syntax diff value from CHUNK-VALUES.
366 See also `mumamo-chunk-value-set-min'."
367 (nth 3 chunk-values))
368 (defsubst mumamo-chunk-value-syntax-max (chunk-values)
369 "Get max syntax diff value from CHUNK-VALUES.
370 See also `mumamo-chunk-value-set-min'."
371 (nth 4 chunk-values))
372 (defsubst mumamo-chunk-value-parseable-by (chunk-values)
373 "Get parseable-by from CHUNK-VALUES.
374 See also `mumamo-chunk-value-set-min'.
375 For parseable-by see `mumamo-find-possible-chunk'."
376 (nth 5 chunk-values))
377 ;; (defsubst mumamo-chunk-prev-chunk (chunk-values)
378 ;; "Get previous chunk from CHUNK-VALUES.
379 ;; See also `mumamo-chunk-value-set-min'."
380 ;; (nth 6 chunk-values))
381 (defsubst mumamo-chunk-value-fw-exc-fun (chunk-values)
382 "Get function that find chunk end from CHUNK-VALUES.
383 See also `mumamo-chunk-value-set-min'."
384 (nth 6 chunk-values))
386 (defsubst mumamo-chunk-major-mode (chunk)
387 "Get major mode specified in CHUNK."
389 ;;(assert (overlay-buffer chunk))
390 (let ((mode-spec (if chunk
391 (mumamo-chunk-car chunk 'mumamo-major-mode)
392 (mumamo-main-major-mode))))
393 (mumamo-major-mode-from-modespec mode-spec)))
395 (defsubst mumamo-chunk-syntax-min-max (chunk no-obscure)
397 (let* ((ovl-end (overlay-end chunk))
398 (ovl-start (overlay-start chunk))
399 (syntax-min (min ovl-end
401 (or (overlay-get chunk 'mumamo-syntax-min-d)
403 ;;(dummy (msgtrc "chunk-syntax-min-max:syntax-min=%s, chunk=%S" syntax-min chunk))
406 (- (overlay-end chunk)
407 (or (overlay-get chunk 'mumamo-syntax-max-d)
409 (if (= (1+ (buffer-size))
412 ;; Note: We must subtract one here because
413 ;; overlay-end is +1 from the last point in the
416 ;; This cured the problem with
417 ;; kubica-freezing-i.html that made Emacs loop
418 ;; in `font-lock-extend-region-multiline'. But
419 ;; was it really this one, I can't find any
420 ;; 'font-lock-multiline property. So it should
421 ;; be `font-lock-extend-region-whole-lines'.
423 ;; Should not the problem then be the value of font-lock-end?
425 ;; Fix-me: however this is not correct since it
426 ;; leads to not fontifying the last character in
427 ;; the chunk, see bug 531324.
429 ;; I think this is cured by now. I have let
430 ;; bound `font-lock-extend-region-functions'
431 ;; once more before the call to
432 ;; `font-lock-fontify-region'.
436 (obscure (unless no-obscure (overlay-get chunk 'obscured)))
437 (region-info (cadr obscure))
438 (obscure-min (car region-info))
439 (obscure-max (cdr region-info))
440 ;;(dummy (message "syn-mn-mx:obs=%s r-info=%s ob=%s/%s" obscure region-info obscure-min obscure-max ))
441 (actual-min (max (or obscure-min ovl-start)
442 (or syntax-min ovl-start)))
443 (actual-max (min (or obscure-max ovl-end)
444 (or syntax-max ovl-end)))
445 (maj (mumamo-chunk-car chunk 'mumamo-major-mode))
446 ;;(dummy (message "syn-mn-mx:obs=%s r-info=%s ob=%s/%s ac=%s/%s" obscure region-info obscure-min obscure-max actual-min actual-max))
448 (cons actual-min actual-max))))
450 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
453 ;; Borrowed from font-lock.el
454 (defmacro mumamo-save-buffer-state (varlist &rest body)
455 "Bind variables according to VARLIST and eval BODY restoring buffer state.
456 Do not record undo information during evaluation of BODY."
457 (declare (indent 1) (debug let))
458 (let ((modified (make-symbol "modified")))
459 `(let* ,(append varlist
460 `((,modified (buffer-modified-p))
462 (inhibit-read-only t)
463 (inhibit-point-motion-hooks t)
464 (inhibit-modification-hooks t)
467 buffer-file-truename))
471 (restore-buffer-modified-p nil)))))
474 (defmacro mumamo-jit-with-buffer-unmodified (&rest body)
475 "Eval BODY, preserving the current buffer's modified state."
477 (let ((modified (make-symbol "modified")))
478 `(let ((,modified (buffer-modified-p)))
482 (restore-buffer-modified-p nil))))))
484 (defmacro mumamo-with-buffer-prepared-for-jit-lock (&rest body)
485 "Execute BODY in current buffer, overriding several variables.
486 Preserves the `buffer-modified-p' state of the current buffer."
488 `(mumamo-jit-with-buffer-unmodified
489 (let ((buffer-undo-list t)
490 (inhibit-read-only t)
491 (inhibit-point-motion-hooks t)
492 (inhibit-modification-hooks t)
495 buffer-file-truename)
498 (defmacro mumamo-condition-case (var body-form &rest handlers)
499 "Like `condition-case', but optional.
500 If `mumamo-use-condition-case' is non-nil then do
506 Otherwise just evaluate BODY-FORM."
507 (declare (indent 2) (debug t))
508 `(if (not mumamo-use-condition-case)
509 (let* ((debugger (or mumamo-debugger 'debug))
510 (debug-on-error (if debugger t debug-on-error)))
516 (defmacro mumamo-msgfntfy (format-string &rest args)
517 "Give some messages during fontification.
518 This macro should just do nothing during normal use. However if
519 there are any problems you can uncomment one of the lines in this
520 macro and recompile/reeval mumamo.el to get those messages.
522 You have to search the code to see where you will get them. All
523 uses are in this file.
525 FORMAT-STRING and ARGS have the same meaning as for the function
527 ;;(list 'apply (list 'quote 'msgtrc) format-string (append '(list) args))
528 ;;(list 'apply (list 'quote 'message) format-string (append '(list) args))
529 ;;(list 'progn 'apply (list 'quote 'message) format-string (append '(list) args) nil)
530 ;; (condition-case err
531 ;; (list 'apply (list 'quote 'message) format-string (append '(list) args)) ;; <--
532 ;; (error (message "err in msgfntfy %S" err)))
533 ;;(message "%s %S" format-string args)
534 ;;(list 'apply (list 'quote 'message) (list 'concat "%s: " format-string)
535 ;; (list 'get-internal-run-time) (append '(list) args))
537 ;;(mumamo-msgfntfy "my-format=%s" (get-internal-run-time))
539 (defmacro mumamo-msgindent (format-string &rest args)
540 "Give some messages during indentation.
541 This macro should just do nothing during normal use. However if
542 there are any problems you can uncomment one of the lines in this
543 macro and recompile/reeval mumamo.el to get those messages.
545 You have to search the code to see where you will get them. All
546 uses are in this file.
548 FORMAT-STRING and ARGS have the same meaning as for the function
550 ;;(list 'apply (list 'quote 'msgtrc) format-string (append '(list) args))
551 ;;(list 'apply (list 'quote 'message) format-string (append '(list) args)) ;; <---
552 ;;(list 'apply (list 'quote 'message) (list 'concat "%s: " format-string)
553 ;; (list 'get-internal-run-time) (append '(list) args))
556 (defmacro mumamo-with-major-mode-setup (major for-what &rest body)
557 "Run code with some local variables set as in specified major mode.
558 Set variables as needed for major mode MAJOR when doing FOR-WHAT
559 and then run BODY using `with-syntax-table'.
561 FOR-WHAT is used to choose another major mode than MAJOR in
562 certain cases. It should be 'fontification or 'indentation.
564 Note: We must let-bind the variables here instead of make them buffer
565 local since they otherwise could be wrong at \(point) in top
566 level \(ie user interaction level)."
567 (declare (indent 2) (debug t))
568 `(let ((need-major-mode (mumamo-get-major-mode-substitute ,major ,for-what)))
569 ;;(msgtrc "mumamo-with-major-mode-setup %s => %s, modified=%s" ,major need-major-mode (buffer-modified-p))
570 ;;(msgtrc "with-major-mode-setup <<<<<<<<<< body=%S\n>>>>>>>>>>" '(progn ,@body))
571 ;;(msgtrc "with-major-mode-setup:in buffer %s after-chunk=%s" (current-buffer) (when (boundp 'after-chunk) after-chunk))
572 (let ((major-mode need-major-mode)
573 (evaled-set-mode (mumamo-get-major-mode-setup need-major-mode)))
574 ;;(message ">>>>>> before %s" evaled-set-mode)
575 ;;(message ">>>>>> before %s, body=%s" evaled-set-mode (list ,@body))
576 (funcall (symbol-value evaled-set-mode)
579 ;;(mumamo-msgfntfy "<<<<<< after evaled-set-mode modified=%s" (buffer-modified-p))
582 (defmacro mumamo-with-major-mode-fontification (major &rest body)
583 "With fontification variables set as major mode MAJOR eval BODY.
584 This is used during font locking and indentation. The variables
585 affecting those are set as they are in major mode MAJOR.
587 See the code in `mumamo-fetch-major-mode-setup' for exactly which
588 local variables that are set."
589 (declare (indent 1) (debug t))
590 `(mumamo-with-major-mode-setup ,major 'fontification
592 ;; Fontification disappears in for example *grep* if
593 ;; font-lock-mode-major-mode is 'permanent-local t.
594 ;;(put 'font-lock-mode-major-mode 'permanent-local t)
596 (defmacro mumamo-with-major-mode-indentation (major &rest body)
597 "With indentation variables set as in another major mode do things.
598 Same as `mumamo-with-major-mode-fontification' but for
599 indentation. See that function for some notes about MAJOR and
601 (declare (indent 1) (debug t))
602 `(mumamo-with-major-mode-setup ,major 'indentation ,@body))
604 ;; fix-me: tell no sub-chunks in sub-chunks
606 (defmacro define-mumamo-multi-major-mode (fun-sym spec-doc chunks)
607 "Define a function that turn on support for multiple major modes.
608 Define a function FUN-SYM that set up to divide the current
609 buffer into chunks with different major modes.
611 The documentation string for FUN-SYM should contain the special
612 documentation in the string SPEC-DOC, general documentation for
613 functions of this type and information about chunks.
615 The new function will use the definitions in CHUNKS \(which is
616 called a \"chunk family\") to make the dividing of the buffer.
618 The function FUN-SYM can be used to setup a buffer instead of a
621 - The function FUN-SYM can be called instead of calling a major
622 mode function when you want to use multiple major modes in a
625 - The defined function can be used instead of a major mode
626 function in for example `auto-mode-alist'.
628 - As the very last thing FUN-SYM will run the hook FUN-SYM-hook,
629 just as major modes do.
631 - There is also a general hook, `mumamo-turn-on-hook', which is
632 run when turning on mumamo with any of these functions. This
633 is run right before the hook specific to any of the functions
634 above that turns on the multiple major mode support.
636 - The multi major mode FUN-SYM has a keymap named FUN-SYM-map.
637 This overrides the major modes' keymaps since it is handled as
640 - There is also a special mumamo keymap, `mumamo-map' that is
641 active in every buffer with a multi major mode. This is also
642 handled as a minor mode keymap and therefor overrides the major
645 - However when this support for multiple major mode is on the
646 buffer is divided into chunks, each with its own major mode.
648 - The chunks are fontified according the major mode assigned to
651 - Indenting is also done according to the major mode assigned to
654 - The actual major mode used in the buffer is changed to the one
655 in the chunk when moving point between these chunks.
657 - When major mode is changed the hooks for the new major mode,
658 `after-change-major-mode-hook' and `change-major-mode-hook' are
661 - There will be an alias for FUN-SYM called mumamo-alias-FUN-SYM.
662 This can be used to check whic multi major modes have been
665 ** A little bit more technical description:
667 The dividing of a buffer into chunks is done during fontification
668 by `mumamo-get-chunk-at'.
670 The name of the function is saved in in the buffer local variable
671 `mumamo-multi-major-mode' when the function is called.
673 All functions defined by this macro is added to the list
674 `mumamo-defined-multi-major-modes'.
676 Basically Mumamo handles only major modes that uses jit-lock.
677 However as a special effort also `nxml-mode' and derivatives
678 thereof are handled. Since it seems impossible to me to restrict
679 those major modes fontification to only a chunk without changing
680 `nxml-mode' the fontification is instead done by
681 `html-mode'/`sgml-mode' for chunks using `nxml-mode' and its
684 CHUNKS is a list where each entry have the format
686 \(CHUNK-DEF-NAME MAIN-MAJOR-MODE SUBMODE-CHUNK-FUNCTIONS)
688 CHUNK-DEF-NAME is the key name by which the entry is recognized.
689 MAIN-MAJOR-MODE is the major mode used when there is no chunks.
690 If this is nil then `major-mode' before turning on this mode will
693 SUBMODE-CHUNK-FUNCTIONS is a list of the functions that does the
694 chunk division of the buffer. They are tried in the order they
695 appear here during the chunk division process.
697 If you want to write new functions for chunk divisions then
698 please see `mumamo-find-possible-chunk'. You can perhaps also
699 use `mumamo-quick-static-chunk' which is more easy-to-use
700 alternative. See also the file mumamo-fun.el where there are
701 many routines for chunk division.
703 When you write those new functions you may want to use some of
704 the functions for testing chunks:
706 `mumamo-test-create-chunk-at' `mumamo-test-create-chunks-at-all'
707 `mumamo-test-easy-make' `mumamo-test-fontify-region'
709 These are in the file mumamo-test.el."
710 ;;(let ((c (if (symbolp chunks) (symbol-value chunks) chunks))) (message "c=%S" c))
711 (let* (;;(mumamo-describe-chunks (make-symbol "mumamo-describe-chunks"))
712 (turn-on-fun (if (symbolp fun-sym)
714 (error "Parameter FUN-SYM must be a symbol")))
715 (turn-on-fun-alias (intern (concat "mumamo-alias-" (symbol-name fun-sym))))
716 ;; Backward compatibility nXhtml v 1.60
717 (turn-on-fun-old (when (string= (substring (symbol-name fun-sym) -5)
719 (intern (substring (symbol-name fun-sym) 0 -5))))
720 (turn-on-hook (intern (concat (symbol-name turn-on-fun) "-hook")))
721 (turn-on-map (intern (concat (symbol-name turn-on-fun) "-map")))
722 (turn-on-hook-doc (concat "Hook run at the very end of `"
723 (symbol-name turn-on-fun) "'."))
724 (chunks2 (if (symbolp chunks)
725 (symbol-value chunks)
734 This function is called a multi major mode. It sets up for
735 multiple major modes in the buffer in the following way:
738 ;; Fix-me: During byte compilation the next line is not
739 ;; expanded as I thought because the functions in CHUNKS
740 ;; are not defined. How do I fix this? Move out the
741 ;; define-mumamo-multi-major-mode calls?
742 (funcall 'mumamo-describe-chunks chunks2)
744 At the very end this multi major mode function runs first the hook
745 `mumamo-turn-on-hook' and then `" (symbol-name turn-on-hook) "'.
747 There is a keymap specific to this multi major mode, but it is
748 not returned by `current-local-map' which returns the chunk's
749 major mode's local keymap.
751 The multi mode keymap is named `" (symbol-name turn-on-map) "'.
755 The main use for a multi major mode is to use it instead of a
756 normal major mode in `auto-mode-alist'. \(You can of course call
757 this function directly yourself too.)
759 The value of `mumamo-multi-major-mode' tells you which multi
760 major mode if any has been turned on in a buffer. For more
761 information about multi major modes please see
762 `define-mumamo-multi-major-mode'.
764 Note: When adding new font-lock keywords for major mode chunks
765 you should use the function `mumamo-refresh-multi-font-lock'
769 ;;(add-to-list 'mumamo-defined-multi-major-modes (cons (car ',chunks2) ',turn-on-fun))
770 (mumamo-add-to-defined-multi-major-modes (cons (car ',chunks2) ',turn-on-fun))
771 (defvar ,turn-on-hook nil ,turn-on-hook-doc)
772 (defvar ,turn-on-map (make-sparse-keymap)
773 ,(concat "Keymap for multi major mode function `"
774 (symbol-name turn-on-fun) "'"))
775 (defvar ,turn-on-fun nil)
776 (make-variable-buffer-local ',turn-on-fun)
777 (put ',turn-on-fun 'permanent-local t)
778 (put ',turn-on-fun 'mumamo-chunk-family (copy-tree ',chunks2))
779 (put ',turn-on-fun-alias 'mumamo-chunk-family (copy-tree ',chunks2))
780 (defun ,turn-on-fun nil ,docstring
782 (let ((old-major-mode (or mumamo-major-mode
784 (kill-all-local-variables)
785 (run-hooks 'change-major-mode-hook)
786 (setq mumamo-multi-major-mode ',turn-on-fun)
787 (setq ,turn-on-fun t)
788 (mumamo-add-multi-keymap ',turn-on-fun ,turn-on-map)
789 (setq mumamo-current-chunk-family (copy-tree ',chunks2))
790 (mumamo-turn-on-actions old-major-mode)
791 (run-hooks ',turn-on-hook)))
792 (defalias ',turn-on-fun-alias ',turn-on-fun)
793 (when (intern-soft ',turn-on-fun-old)
794 (defalias ',turn-on-fun-old ',turn-on-fun))
798 (defun mumamo-add-to-defined-multi-major-modes (entry)
799 (add-to-list 'mumamo-defined-multi-major-modes entry))
801 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
804 (defsubst mumamo-while (limit counter where)
805 (let ((count (symbol-value counter)))
808 (msgtrc "Reached (while limit=%s, where=%s)" limit where)
810 (set counter (1+ count)))))
812 ;; (defun dbg-smarty-err ()
816 ;; ;; (backward-char)
817 ;; ;; (backward-char)
818 ;; ;; (search-backward "}")
820 ;; ;; This gives an error rather often, but not always:
822 ;; (search-backward "}")
825 ;; (defun dbg-smarty-err2 ()
828 ;; ;; Start in nxhtml part and make sure the insertion is in smarty
829 ;; ;; part. Gives reliably an error if moved backward so point stay in
830 ;; ;; the new nxhtml-mode part, otherwise not.
832 ;; ;; Eh, no. If chunk family is changed and reset there is no more an
835 ;; ;; Seems to be some race condition, but I am unable to understand
836 ;; ;; how. I believed that nxml always left in a reliable state. Is
837 ;; ;; this a state problem in mumamo or nxml? I am unable to make it
838 ;; ;; happen again now.
840 ;; ;; I saw one very strange thing: The error message got inserted in
841 ;; ;; the .phps buffer once. How could this happen? Is this an Emacs
842 ;; ;; bug? Can't see how this could happen since it is the message
843 ;; ;; function that outputs the message. A w32 race condition? Are
844 ;; ;; people aware that the message queue runs in parallell? (I have
845 ;; ;; tried to ask on the devel list, but got no answer at that time.)
850 (defvar msgtrc-buffer
853 "Buffer or name of buffer for trace messages.
857 (defun msgtrc (format-string &rest args)
858 "Print message to `msgtrc-buffer'.
859 Arguments FORMAT-STRING and ARGS are like for `message'."
861 nil ;;(apply 'message format-string args)
862 ;; bug#3350 prevents use of this:
863 (let ((trc-buffer (get-buffer-create msgtrc-buffer))
864 ;; Cure 3350: Stop insert from deactivating the mark
866 (with-current-buffer trc-buffer
867 (goto-char (point-max))
868 (insert "MU:" (apply 'format format-string args) "\n")
869 ;;(insert "constant string\n")
870 (when buffer-file-name (write-region nil nil buffer-file-name))))))
872 (defvar mumamo-message-file-buffer nil)
873 (defsubst mumamo-msgtrc-to-file ()
874 "Start writing message to file. Erase `msgtrc-buffer' first."
875 (unless mumamo-message-file-buffer
876 (setq mumamo-message-file-buffer (find-file-noselect "c:/emacs/bugs/temp-messages.txt"))
877 (setq msgtrc-buffer mumamo-message-file-buffer)
878 (with-current-buffer mumamo-message-file-buffer
881 (defvar mumamo-display-error-lwarn nil
882 "Set to t to call `lwarn' on fontification errors.
883 If this is t then `*Warnings*' buffer will popup on fontification
885 (defvar mumamo-display-error-stop nil
886 "Set to t to stop fontification on errors.")
888 (defun mumamo-message-with-face (msg face)
889 "Put MSG with face FACE in *Messages* buffer."
890 (let ((start (+ (with-current-buffer msgtrc-buffer
893 ;; This is for the echo area:
894 (msg-with-face (propertize (format "%s" msg)
897 (msgtrc "%s" msg-with-face)
898 ;; This is for the buffer:
899 (with-current-buffer msgtrc-buffer
900 (goto-char (point-max))
902 (put-text-property start (point)
905 ;;(run-with-idle-timer 1 nil 'mumamo-show-report-message)
906 (defun mumamo-show-report-message ()
907 "Tell the user there is a long error message."
908 (save-match-data ;; runs in timer
909 (mumamo-message-with-face
910 "MuMaMo error, please look in the *Messages* buffer"
913 ;; This code can't be used now because `debugger' is currently not
914 ;; useable in timers. I keep it here since I hope someone will make it
915 ;; possible in the future.
917 ;; (defmacro mumamo-get-backtrace-if-error (bodyform)
918 ;; "Evaluate BODYFORM, return a list with error message and backtrace.
919 ;; If there is an error in BODYFORM then return a list with the
920 ;; error message and the backtrace as a string. Otherwise return
923 ;; (lambda (&rest debugger-args)
924 ;; (let ((debugger-ret (with-output-to-string (backtrace))))
925 ;; ;; I believe we must put the result in a buffer,
926 ;; ;; otherwise `condition-case' might erase it:
927 ;; (with-current-buffer (get-buffer-create "TEMP GET BACKTRACE")
929 ;; (insert debugger-ret)))))
930 ;; (debug-on-error t)
931 ;; (debug-on-signal t))
932 ;; (mumamo-condition-case err
937 ;; (let* ((errmsg (error-message-string err))
939 ;; (with-current-buffer
940 ;; (get-buffer "TEMP GET BACKTRACE") (buffer-string)))
941 ;; ;; Remove lines from this routine:
942 ;; (debugger-lines (split-string dbg1-ret "\n"))
943 ;; (dbg-ret (mapconcat 'identity (nthcdr 6 debugger-lines) "\n"))
945 ;; (list errmsg (concat errmsg "\n" dbg-ret)))))))
947 ;;(mumamo-display-error 'test-lwarn-type "testing 1=%s, 2=%s" "one" 'two)
948 (defun mumamo-display-error (lwarn-type format-string &rest args)
949 "Display a message plus traceback in the *Messages* buffer.
950 Use this for errors that happen during fontification or when
953 LWARN-TYPE is used as the type argument to `lwarn' if warnings
954 are displayed. FORMAT-STRING and ARGS are used as the
955 corresponding arguments to `message' and `lwarn'.
957 All the output from this function in the *Messages* buffer is
958 displayed with the highlight face. After the message printed by
959 `message' is traceback from where this function was called.
960 Note: There is no error generated, just a traceback that is put
961 in *Messages* as above.
963 Display an error message using `message' and colorize it using
964 the `highlight' face to make it more prominent. Add a backtrace
965 colored with the `highlight' face to the buffer *Messages*. Then
966 display the error message once again after this so that the user
969 If `mumamo-display-error-lwarn' is non-nil, indicate the error by
970 calling `lwarn'. This will display the `*Warnings*' buffer and
971 thus makes it much more easy to spot that there was an error.
973 If `mumamo-display-error-stop' is non-nil raise an error that may
976 ;; Warnings are sometimes disturbning, make it optional:
977 (when mumamo-display-error-lwarn
978 (apply 'lwarn lwarn-type :error format-string args))
980 (let ((format-string2 (concat "%s: " format-string))
981 (bt (with-output-to-string (backtrace))))
983 (mumamo-message-with-face
985 (apply 'format format-string2 lwarn-type args)
987 (format "** In buffer %s\n" (current-buffer))
991 ;; Output message once again so the user can see it:
992 (apply 'message format-string2 lwarn-type args)
993 ;; But ... there might be more messages so wait until things has
994 ;; calmed down and then show a message telling that there was an
995 ;; error and that there is more information in the *Messages*
997 (run-with-idle-timer 1 nil 'mumamo-show-report-message)
1000 (when mumamo-display-error-stop
1001 ;;(font-lock-mode -1)
1002 (setq font-lock-mode nil)
1003 (when (timerp jit-lock-context-timer)
1004 (cancel-timer jit-lock-context-timer))
1005 (when (timerp jit-lock-defer-timer)
1006 (cancel-timer jit-lock-defer-timer))
1007 (apply 'error format-string2 lwarn-type args))))
1010 (defun mumamo-debug-to-backtrace (&rest debugger-args)
1011 "This function should give a backtrace during fontification errors.
1012 The variable `debugger' should then be this function. See the
1013 function `debug' for an explanation of DEBUGGER-ARGS.
1015 Fix-me: Can't use this function yet since the display routines
1016 uses safe_eval and safe_call."
1017 (mumamo-display-error 'mumamo-debug-to-backtrace
1019 (nth 1 debugger-args)))
1021 ;; (defun my-test-err3 ()
1023 ;; (let ((debugger 'mumamo-debug-to-backtrace)
1024 ;; (debug-on-error t))
1029 ;;(set-default 'mumamo-use-condition-case nil)
1030 ;;(set-default 'mumamo-use-condition-case t)
1031 (defvar mumamo-use-condition-case t)
1032 (make-variable-buffer-local 'mumamo-use-condition-case)
1033 (put 'mumamo-use-condition-case 'permanent-local t)
1035 (defvar mumamo-debugger 'mumamo-debug-to-backtrace)
1036 (make-variable-buffer-local 'mumamo-debugger)
1037 (put 'mumamo-debugger 'permanent-local t)
1039 ;; (defun my-test-err4 ()
1041 ;; (mumamo-condition-case err
1043 ;; (arith-error (message "here"))
1044 ;; (error (message "%s, %s" err (error-message-string err)))
1047 (defvar mumamo-warned-once nil)
1048 (make-variable-buffer-local 'mumamo-warned-once)
1049 (put 'mumamo-warned-once 'permanent-local t)
1051 ; (append '(0 1) '(a b))
1052 (defun mumamo-warn-once (type message &rest args)
1053 "Warn only once with TYPE, MESSAGE and ARGS.
1054 If the same problem happens again then do not warn again."
1055 (let ((msgrec (append (list type message) args)))
1056 (unless (member msgrec mumamo-warned-once)
1057 (setq mumamo-warned-once
1058 (cons msgrec mumamo-warned-once))
1059 ;;(apply 'lwarn type :warning message args)
1060 (apply 'message (format "%s: %s" type message) args)
1063 (defun mumamo-add-help-tabs ()
1064 "Add key bindings for moving between buttons.
1065 Add bindings similar to those in `help-mode' for moving between
1067 (local-set-key [tab] 'forward-button)
1068 (local-set-key [(meta tab)] 'backward-button)
1069 (local-set-key [(shift tab)] 'backward-button)
1070 (local-set-key [backtab] 'backward-button))
1072 (defun mumamo-insert-describe-button (symbol type)
1073 "Insert a text button that describes SYMBOL of type TYPE."
1074 (let ((func `(lambda (btn)
1075 (funcall ',type ',symbol))))
1076 (mumamo-add-help-tabs)
1078 (symbol-name symbol)
1079 :type 'help-function
1085 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1089 (defgroup mumamo nil
1090 "Customization group for multiple major modes in a buffer."
1097 ;;(setq mumamo-set-major-mode-delay -1)
1098 ;;(setq mumamo-set-major-mode-delay 5)
1099 (defcustom mumamo-set-major-mode-delay idle-update-delay
1100 "Delay this number of seconds before setting major mode.
1101 When point enters a region where the major mode should be
1102 different than the current major mode, wait until Emacs has been
1103 idle this number of seconds before switching major mode.
1105 If negative switch major mode immediately.
1107 Ideally the switching of major mode should occur immediately when
1108 entering a region. However this can make movements a bit unsmooth
1109 for some major modes on a slow computer. Therefore on a slow
1110 computer use a short delay.
1112 If you have a fast computer and want to use mode specific
1113 movement commands then set this variable to -1.
1115 I tried to measure the time for switching major mode in mumamo.
1116 For most major modes it took 0 ms, but for `nxml-mode' and its
1117 derivate it took 20 ms on a 3GHz CPU."
1122 (defgroup mumamo-display nil
1123 "Customization group for mumamo chunk display."
1126 (defun mumamo-update-this-buffer-margin-use ()
1127 (mumamo-update-buffer-margin-use (current-buffer)))
1129 (define-minor-mode mumamo-margin-info-mode
1130 "Display chunk info in margin when on.
1131 Display chunk depth and major mode where a chunk begin in left or
1132 right margin. \(The '-mode' part of the major mode is stripped.)
1134 See also `mumamo-margin-use'.
1136 Note: When `linum-mode' is on the right margin is always used
1137 now \(since `linum-mode' uses the left)."
1138 :group 'mumamo-display
1139 (mumamo-update-this-buffer-margin-use)
1140 (if mumamo-margin-info-mode
1142 ;;(add-hook 'window-configuration-change-hook 'mumamo-update-this-buffer-margin-use nil t)
1143 (add-hook 'linum-mode-hook 'mumamo-update-this-buffer-margin-use nil t)
1145 ;;(remove-hook 'window-configuration-change-hook 'mumamo-update-this-buffer-margin-use t)
1146 (remove-hook 'linum-mode-hook 'mumamo-update-this-buffer-margin-use t)
1148 ;;(put 'mumamo-margin-info-mode 'permanent-local t)
1150 (defun mumamo-margin-info-mode-turn-off ()
1151 (mumamo-margin-info-mode -1))
1152 (put 'mumamo-margin-info-mode-turn-off 'permanent-local-hook t)
1154 (define-globalized-minor-mode mumamo-margin-info-global-mode mumamo-margin-info-mode
1155 (lambda () (when (and (boundp 'mumamo-multi-major-mode)
1156 mumamo-multi-major-mode)
1157 (mumamo-margin-info-mode 1)))
1158 :group 'mumamo-display)
1160 (defcustom mumamo-margin-use '(left-margin 13)
1161 "Display chunk info in left or right margin if non-nil."
1162 :type '(list (radio (const :tag "Display chunk info in left margin" left-margin)
1163 (const :tag "Display chunk info in right margin" right-margin))
1164 (integer :tag "Margin width (when used)" :value 13))
1165 :set (lambda (sym val)
1166 (set-default sym val)
1167 (when (fboundp 'mumamo-update-all-buffers-margin-use)
1168 (mumamo-update-all-buffers-margin-use)))
1169 :group 'mumamo-display)
1171 (defun mumamo-update-all-buffers-margin-use ()
1172 (dolist (buf (buffer-list))
1173 (mumamo-update-buffer-margin-use buf)))
1175 (define-minor-mode mumamo-no-chunk-coloring
1176 "Use no background colors to distinguish chunks.
1177 When this minor mode is on in a buffer no chunk coloring is done
1178 in that buffer. This is overrides `mumamo-chunk-coloring'. It
1179 is meant for situations when you temporarily need to remove the
1182 :group 'mumamo-display
1185 (put 'mumamo-no-chunk-coloring 'permanent-local t)
1188 ;; (setq mumamo-chunk-coloring 4)
1189 (defcustom mumamo-chunk-coloring 0
1190 "Color chunks with depth greater than or equal to this.
1191 When 0 all chunks will be colored. If 1 all sub mode chunks will
1193 :type '(integer :tag "Color chunks with depth greater than this")
1194 :group 'mumamo-display)
1196 (defface mumamo-background-chunk-major
1197 '((((class color) (min-colors 88) (background dark))
1198 ;;:background "blue3")
1199 :background "MidnightBlue")
1200 (((class color) (min-colors 88) (background light))
1201 ;;:background "lightgoldenrod2")
1202 :background "cornsilk")
1203 (((class color) (min-colors 16) (background dark))
1204 :background "blue4")
1205 (((class color) (min-colors 16) (background light))
1206 :background "cornsilk")
1207 (((class color) (min-colors 8))
1209 (((type tty) (class mono))
1211 (t :background "gray"))
1212 "Background colors for chunks in sub modes.
1213 You should only specify :background here, otherwise it will
1214 interfere with syntax highlighting."
1215 :group 'mumamo-display)
1217 (defface mumamo-background-chunk-submode1
1218 '((((class color) (min-colors 88) (background dark))
1219 ;;:background "blue3")
1220 :background "DarkGreen"
1221 ;;:background "#081010"
1223 (((class color) (min-colors 88) (background light))
1224 ;;:background "lightgoldenrod2")
1225 :background "Azure")
1226 (((class color) (min-colors 16) (background dark))
1227 :background "blue3")
1228 (((class color) (min-colors 16) (background light))
1229 :background "azure")
1230 (((class color) (min-colors 8))
1232 (((type tty) (class mono))
1234 (t :background "gray"))
1235 "Background colors for chunks in major mode.
1236 You should only specify :background here, otherwise it will
1237 interfere with syntax highlighting."
1238 :group 'mumamo-display)
1240 (defface mumamo-background-chunk-submode2
1241 '((((class color) (min-colors 88) (background dark))
1242 ;;:background "blue3")
1243 :background "dark green")
1244 (((class color) (min-colors 88) (background light))
1245 ;;:background "lightgoldenrod2")
1246 :background "#e6ff96")
1247 (((class color) (min-colors 16) (background dark))
1248 :background "blue3")
1249 (((class color) (min-colors 16) (background light))
1250 :background "azure")
1251 (((class color) (min-colors 8))
1253 (((type tty) (class mono))
1255 (t :background "gray"))
1256 "Background colors for chunks in major mode.
1257 You should only specify :background here, otherwise it will
1258 interfere with syntax highlighting."
1259 :group 'mumamo-display)
1261 (defface mumamo-background-chunk-submode3
1262 '((((class color) (min-colors 88) (background dark))
1263 ;;:background "blue3")
1264 :background "dark green")
1265 (((class color) (min-colors 88) (background light))
1266 ;;:background "lightgoldenrod2")
1267 :background "#f7d1f4")
1268 ;;:background "green")
1269 (((class color) (min-colors 16) (background dark))
1270 :background "blue3")
1271 (((class color) (min-colors 16) (background light))
1272 :background "azure")
1273 (((class color) (min-colors 8))
1275 (((type tty) (class mono))
1277 (t :background "gray"))
1278 "Background colors for chunks in major mode.
1279 You should only specify :background here, otherwise it will
1280 interfere with syntax highlighting."
1281 :group 'mumamo-display)
1283 (defface mumamo-background-chunk-submode4
1284 '((((class color) (min-colors 88) (background dark))
1285 ;;:background "blue3")
1286 :background "dark green")
1287 (((class color) (min-colors 88) (background light))
1288 ;;:background "lightgoldenrod2")
1289 :background "orange")
1290 (((class color) (min-colors 16) (background dark))
1291 :background "blue3")
1292 (((class color) (min-colors 16) (background light))
1293 :background "azure")
1294 (((class color) (min-colors 8))
1296 (((type tty) (class mono))
1298 (t :background "gray"))
1299 "Background colors for chunks in major mode.
1300 You should only specify :background here, otherwise it will
1301 interfere with syntax highlighting."
1302 :group 'mumamo-display)
1304 (defcustom mumamo-background-chunk-major 'mumamo-background-chunk-major
1305 "Background colors for chunks in major mode.
1306 Pointer to face with background color.
1308 If you do not want any special background color use the face named
1311 :group 'mumamo-display)
1313 (defcustom mumamo-background-chunk-submode1 'mumamo-background-chunk-submode1
1314 "Background colors for chunks in sub modes.
1315 Pointer to face with background color.
1317 If you do not want any special background color use the face named
1320 :group 'mumamo-display)
1322 (defcustom mumamo-background-chunk-submode2 'mumamo-background-chunk-submode2
1323 "Background colors for chunks in sub modes.
1324 Pointer to face with background color.
1326 If you do not want any special background color use the face named
1329 :group 'mumamo-display)
1331 (defcustom mumamo-background-chunk-submode3 'mumamo-background-chunk-submode3
1332 "Background colors for chunks in sub modes.
1333 Pointer to face with background color.
1335 If you do not want any special background color use the face named
1338 :group 'mumamo-display)
1340 (defcustom mumamo-background-chunk-submode4 'mumamo-background-chunk-submode4
1341 "Background colors for chunks in sub modes.
1342 Pointer to face with background color.
1344 If you do not want any special background color use the face named
1347 :group 'mumamo-display)
1349 ;; Fix-me: use and enhance this
1350 (defcustom mumamo-background-colors '(mumamo-background-chunk-major
1351 mumamo-background-chunk-submode1
1352 mumamo-background-chunk-submode2
1353 mumamo-background-chunk-submode3
1354 mumamo-background-chunk-submode4
1356 "List of background colors in order of use.
1357 First color is for main major mode chunks, then for submode
1358 chunks, sub-submode chunks etc. Colors are reused in cyclic
1361 The default colors are choosen so that inner chunks has a more
1362 standing out color the further in you get. This is supposed to
1363 be helpful when you make mistakes and the chunk nesting is not
1366 Note: Only the light background colors have been set by me. The
1367 dark background colors might currently be unuseful.
1368 Contributions and suggestions are welcome!
1370 The values in the list should be symbols. Each symbol should either be
1372 1: a variable symbol pointing to a face (or beeing nil)
1374 3: a function with one argument (subchunk depth) returning a
1376 :type '(repeat symbol)
1377 :group 'mumamo-display)
1379 ;;(mumamo-background-color 0)
1380 ;;(mumamo-background-color 1)
1381 ;;(mumamo-background-color 2)
1382 (defun mumamo-background-color (sub-chunk-depth)
1383 (when (and (not mumamo-no-chunk-coloring)
1384 (or (not (integerp mumamo-chunk-coloring)) ;; Old values
1385 (>= sub-chunk-depth mumamo-chunk-coloring)))
1386 (let* ((idx (when mumamo-background-colors
1387 (mod sub-chunk-depth (length mumamo-background-colors))))
1388 (sym (when idx (nth idx mumamo-background-colors)))
1392 (setq fac (symbol-value sym))
1393 (unless (facep fac) (setq fac nil)))
1399 (setq fac (funcall sym sub-chunk-depth))))
1406 (defface mumamo-border-face-in
1407 '((t (:inherit font-lock-preprocessor-face :bold t :italic t :underline t)))
1408 "Face for marking borders."
1409 :group 'mumamo-display)
1411 (defface mumamo-border-face-out
1412 '((t (:inherit font-lock-preprocessor-face :bold t :italic t :underline t)))
1413 "Face for marking borders."
1414 :group 'mumamo-display)
1417 (defgroup mumamo-indentation nil
1418 "Customization group for mumamo chunk indentation."
1421 (defcustom mumamo-submode-indent-offset 2
1422 "Indentation of submode relative outer major mode.
1423 If this is nil then indentation first non-empty line in a
1424 subchunk will \(normally) be 0. See however
1425 `mumamo-indent-line-function-1' for special handling of first
1426 line in subsequent subchunks.
1428 See also `mumamo-submode-indent-offset-0'."
1429 :type '(choice integer
1430 (const :tag "No special"))
1431 :group 'mumamo-indentation)
1433 (defcustom mumamo-submode-indent-offset-0 0
1434 "Indentation of submode at column 0.
1435 This value overrides `mumamo-submode-indent-offset' when the
1436 outer major mode above has indentation 0."
1437 :type '(choice integer
1438 (const :tag "No special"))
1439 :group 'mumamo-indentation)
1441 (defcustom mumamo-indent-major-to-use
1443 ;;(nxhtml-mode html-mode)
1444 (html-mode nxhtml-mode)
1446 "Major mode to use for indentation.
1447 This is normally the major mode specified for the chunk. Here you
1448 can make exceptions."
1450 (list (symbol :tag "Major mode symbol specified")
1451 (command :tag "Major mode to use")))
1452 :group 'mumamo-indentation)
1454 ;;(mumamo-indent-get-major-to-use 'nxhtml-mode)
1455 ;;(mumamo-indent-get-major-to-use 'html-mode)
1456 (defun mumamo-indent-get-major-to-use (major depth)
1457 (or (and (= depth 0)
1458 (cadr (assq major mumamo-indent-major-to-use)))
1461 (defcustom mumamo-indent-widen-per-major
1463 (php-mode (use-widen))
1464 (nxhtml-mode (use-widen (html-mumamo-mode nxhtml-mumamo-mode)))
1465 (html-mode (use-widen (html-mumamo-mode nxhtml-mumamo-mode)))
1467 "Wether do widen buffer during indentation.
1468 If not then the buffer is narrowed to the current chunk when
1469 indenting a line in a chunk."
1471 (list (symbol :tag "Major mode symbol")
1473 (const :tag "Widen buffer during indentation" use-widen)
1474 (repeat (command :tag "Widen if multi major is any of those"))
1476 :group 'mumamo-indentation)
1480 (defgroup mumamo-hi-lock-faces nil
1481 "Faces for hi-lock that are visible in mumamo multiple modes.
1482 This is a workaround for the problem that text properties are
1483 always hidden behind overlay dito.
1485 This faces are not as visible as those that defines background
1486 colors. However they use underlining so they are at least
1489 :group 'mumamo-display
1492 (defface hi-mumamo-yellow
1493 '((((min-colors 88) (background dark))
1494 (:underline "yellow1"))
1495 (((background dark)) (:underline "yellow"))
1496 (((min-colors 88)) (:underline "yellow1"))
1497 (t (:underline "yellow")))
1498 "Default face for hi-lock mode."
1499 :group 'mumamo-hi-lock-faces)
1501 (defface hi-mumamo-pink
1502 '((((background dark)) (:underline "pink"))
1503 (t (:underline "pink")))
1504 "Face for hi-lock mode."
1505 :group 'mumamo-hi-lock-faces)
1507 (defface hi-mumamo-green
1508 '((((min-colors 88) (background dark))
1509 (:underline "green1"))
1510 (((background dark)) (:underline "green"))
1511 (((min-colors 88)) (:underline "green1"))
1512 (t (:underline "green")))
1513 "Face for hi-lock mode."
1514 :group 'mumamo-hi-lock-faces)
1516 (defface hi-mumamo-blue
1517 '((((background dark)) (:underline "light blue"))
1518 (t (:underline "light blue")))
1519 "Face for hi-lock mode."
1520 :group 'mumamo-hi-lock-faces)
1522 (defface hi-mumamo-black-b
1523 '((t (:weight bold :underline t)))
1524 "Face for hi-lock mode."
1525 :group 'mumamo-hi-lock-faces)
1527 (defface hi-mumamo-blue-b
1528 '((((min-colors 88)) (:weight bold :underline "blue1"))
1529 (t (:weight bold :underline "blue")))
1530 "Face for hi-lock mode."
1531 :group 'mumamo-hi-lock-faces)
1533 (defface hi-mumamo-green-b
1534 '((((min-colors 88)) (:weight bold :underline "green1"))
1535 (t (:weight bold :underline "green")))
1536 "Face for hi-lock mode."
1537 :group 'mumamo-hi-lock-faces)
1539 (defface hi-mumamo-red-b
1540 '((((min-colors 88)) (:weight bold :underline "red1"))
1541 (t (:weight bold :underline "red")))
1542 "Face for hi-lock mode."
1543 :group 'mumamo-hi-lock-faces)
1546 ;; (defcustom mumamo-check-chunk-major-same nil
1547 ;; "Check if main major mode is the same as normal mode."
1551 ;; (customize-option 'mumamo-major-modes)
1554 (defgroup mumamo-modes nil
1555 "Customization group for mumamo chunk modes."
1558 (defcustom mumamo-major-modes
1561 js-mode ;; Not autoloaded in the pretest
1567 ;;(css-mode fundamental-mode)
1569 js-mode ;; Not autoloaded in the pretest
1579 ;; For Emacs 22 that do not have nxml by default
1580 ;; Fix me: fallback when autoload fails!
1585 "Alist for conversion of chunk major mode specifier to major mode.
1586 Each entry has the form
1588 \(MAJOR-SPEC MAJORMODE ...)
1590 where the symbol MAJOR-SPEC specifies the code type and should
1591 match the value returned from `mumamo-find-possible-chunk'. The
1592 MAJORMODE symbols are major modes that can be used for editing
1593 that code type. The first available MAJORMODE is the one that is
1596 The MAJOR-SPEC symbols are used by the chunk definitions in
1597 `define-mumamo-multi-major-mode'.
1599 The major modes are not specified directly in the chunk
1600 definitions. Instead a chunk definition contains a symbol that
1601 is looked up in this list to find the chunk's major mode.
1603 The reason for doing it this way is to make it possible to use
1604 new major modes with existing multi major modes. If for example
1605 someone writes a new CSS mode that could easily be used instead
1606 of the current one in `html-mumamo-mode'.
1608 Lookup in this list is done by `mumamo-major-mode-from-modespec'."
1610 :key-type (symbol :tag "Symbol for major mode spec in chunk")
1611 :value-type (repeat (choice
1612 (command :tag "Major mode")
1613 (symbol :tag "Major mode (not yet loaded)")))
1615 :group 'mumamo-modes)
1619 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1620 ;;;; JIT lock functions
1622 (defun mumamo-jit-lock-function (start)
1623 "This function is added to `fontification-functions' by mumamo.
1624 START is a parameter given to functions in that hook."
1625 (mumamo-msgfntfy "mumamo-jit-lock-function %s, ff=%s, just-changed=%s"
1630 (get-text-property start 'fontified)))
1631 mumamo-just-changed-major)
1632 ;;(msgtrc "jit-lock-function %s, ff=%s, just-changed=%s" start (get-text-property start 'fontified) mumamo-just-changed-major)
1633 ;;(msgtrc "mumamo-jit-lock-function enter: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
1634 (if mumamo-just-changed-major
1635 (setq mumamo-just-changed-major nil))
1636 (let ((ret (jit-lock-function start)))
1637 (mumamo-msgfntfy "mumamo-jit-lock-function EXIT %s, ff=%s, just-changed=%s"
1642 (get-text-property start 'fontified)))
1643 mumamo-just-changed-major)
1644 ;;(msgtrc "mumamo-jit-lock-function exit: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
1647 (defun mumamo-jit-lock-register (fun &optional contextual)
1648 "Replacement for `jit-lock-register'.
1649 Avoids refontification, otherwise same. FUN and CONTEXTUAL has
1650 the some meaning as there."
1651 (add-hook 'jit-lock-functions fun nil t)
1652 (when (and contextual jit-lock-contextually)
1653 (set (make-local-variable 'jit-lock-contextually) t))
1657 ;; Replace this with the code below from jit-lock-mode t part:
1658 (setq jit-lock-mode t)
1660 ;; Mark the buffer for refontification.
1661 ;; This is what we want to avoid in mumamo:
1662 ;;(jit-lock-refontify)
1664 ;; Install an idle timer for stealth fontification.
1665 (when (and jit-lock-stealth-time (null jit-lock-stealth-timer))
1666 (setq jit-lock-stealth-timer
1667 (run-with-idle-timer jit-lock-stealth-time t
1668 'jit-lock-stealth-fontify)))
1670 ;; Create, but do not activate, the idle timer for repeated
1671 ;; stealth fontification.
1672 (when (and jit-lock-stealth-time (null jit-lock-stealth-repeat-timer))
1673 (setq jit-lock-stealth-repeat-timer (timer-create))
1674 (timer-set-function jit-lock-stealth-repeat-timer
1675 'jit-lock-stealth-fontify '(t)))
1677 ;; Init deferred fontification timer.
1678 (when (and jit-lock-defer-time (null jit-lock-defer-timer))
1679 (setq jit-lock-defer-timer
1680 (run-with-idle-timer jit-lock-defer-time t
1681 'jit-lock-deferred-fontify)))
1683 ;; Initialize contextual fontification if requested.
1684 (when (eq jit-lock-contextually t)
1685 (unless jit-lock-context-timer
1686 (setq jit-lock-context-timer
1687 (run-with-idle-timer jit-lock-context-time t
1688 'jit-lock-context-fontify)))
1689 (setq jit-lock-context-unfontify-pos
1690 (or jit-lock-context-unfontify-pos (point-max))))
1693 ;;(add-hook 'after-change-functions 'jit-lock-after-change t t)
1694 ;;(add-hook 'after-change-functions 'mumamo-jit-lock-after-change t t)
1695 (add-hook 'after-change-functions 'mumamo-after-change t t)
1696 ;; Set up fontification to call jit:
1697 (let ((ff (reverse fontification-functions)))
1699 ;;(unless (eq f 'jit-lock-function)
1700 (remove-hook 'fontification-functions f t))
1703 (add-hook 'fontification-functions 'mumamo-jit-lock-function nil t)
1706 ;; Fix-me: integrate this with fontify-region!
1707 (defvar mumamo-find-chunks-timer nil)
1708 (make-variable-buffer-local 'mumamo-find-chunks-timer)
1709 (put 'mumamo-find-chunks-timer 'permanent-local t)
1711 (defvar mumamo-find-chunk-delay idle-update-delay)
1712 (make-variable-buffer-local 'mumamo-find-chunk-delay)
1713 (put 'mumamo-find-chunk-delay 'permanent-local t)
1715 (defun mumamo-stop-find-chunks-timer ()
1716 "Stop timer that find chunks."
1717 (when (and mumamo-find-chunks-timer
1718 (timerp mumamo-find-chunks-timer))
1719 (cancel-timer mumamo-find-chunks-timer))
1720 (setq mumamo-find-chunks-timer nil))
1722 (defun mumamo-start-find-chunks-timer ()
1723 "Start timer that find chunks."
1724 (mumamo-stop-find-chunks-timer)
1725 ;; (setq mumamo-find-chunks-timer
1726 ;; (run-with-idle-timer mumamo-find-chunk-delay nil
1727 ;; 'mumamo-find-chunks-in-timer (current-buffer)))
1730 (defun mumamo-find-chunks-in-timer (buffer)
1731 "Run `mumamo-find-chunks' in buffer BUFFER in a timer."
1732 (mumamo-msgfntfy "mumamo-find-chunks-in-timer %s" buffer)
1733 ;;(message "mumamo-find-chunks-in-timer %s" buffer)
1735 (when (buffer-live-p buffer)
1736 (with-current-buffer buffer
1737 (mumamo-find-chunks nil "mumamo-find-chunks-in-timer")))
1738 (error (message "mumamo-find-chunks error: %s" err))))
1741 (defvar mumamo-last-chunk nil)
1742 (make-variable-buffer-local 'mumamo-last-chunk)
1743 (put 'mumamo-last-chunk 'permanent-local t)
1745 (defvar mumamo-last-change-pos nil)
1746 (make-variable-buffer-local 'mumamo-last-change-pos)
1747 (put 'mumamo-last-change-pos 'permanent-local t)
1749 ;; Fix-me: maybe this belongs to contextual fontification? Eh,
1750 ;; no. Unfortunately there is not way to make that handle more than
1752 (defvar mumamo-find-chunk-is-active nil
1753 "Protect from recursive calls.")
1755 ;; Fix-me: temporary things for testing new chunk routines.
1756 (defvar mumamo-find-chunks-level 0)
1757 (setq mumamo-find-chunks-level 0)
1759 (defvar mumamo-old-tail nil)
1760 (make-variable-buffer-local 'mumamo-old-tail)
1761 (put 'mumamo-old-tail 'permanent-local t)
1763 (defun mumamo-update-obscure (chunk pos)
1764 "Update obscure cache."
1765 (let ((obscured (overlay-get chunk 'obscured))
1767 (unless (and obscured (= (car obscured) pos))
1768 (setq region-info (mumamo-get-region-from pos))
1769 ;;(msgtrc "update-obscure:region-info=%s" region-info)
1770 ;; This should not be a chunk here
1771 (mumamo-put-obscure chunk pos region-info))))
1773 (defun mumamo-put-obscure (chunk pos region-or-chunk)
1774 "Cache obscure info."
1775 (assert (overlayp chunk) t)
1776 (when pos (assert (or (markerp pos) (integerp pos)) t))
1777 (let* ((region-info (if (overlayp region-or-chunk)
1778 (cons (overlay-start region-or-chunk)
1779 (overlay-end region-or-chunk))
1781 (obscured (when pos (list pos region-info))))
1782 ;;(msgtrc "put-obscure:region-info=%s, obscured=%s" region-info obscured)
1783 (when region-info (assert (consp region-info) t))
1784 (assert (not (overlayp region-info)) t)
1785 (overlay-put chunk 'obscured obscured)
1786 (setq obscured (overlay-get chunk 'obscured))
1787 ;;(msgtrc " obscured=%s" obscured)
1790 (defun mumamo-get-region-from (point)
1791 "Return mumamo region values for POINT."
1792 ;; Note: `mumamo-get-region-from-1' is defined in mumamo-regions.el
1793 (when (fboundp 'mumamo-get-region-from-1)
1794 (mumamo-get-region-from-1 point)))
1796 (defun mumamo-clear-chunk-ppss-cache (chunk)
1797 (overlay-put chunk 'mumamo-ppss-cache nil)
1798 (overlay-put chunk 'mumamo-ppss-last nil)
1799 (overlay-put chunk 'mumamo-ppss-stats nil))
1801 (defun mumamo-find-chunks (end tracer)
1802 "Find or create chunks from last known chunk.
1803 Ie, start from the end of `mumamo-last-chunk' if this is
1804 non-nil, otherwise 1.
1806 If END is nil then continue till end of buffer or until any input
1807 is available. In this case the return value is undefined.
1809 Otherwise END must be a position in the buffer. Return the
1810 mumamo chunk containing the position. If `mumamo-last-chunk'
1811 ends before END then create chunks upto END."
1812 (when mumamo-multi-major-mode
1813 (let ((chunk (mumamo-find-chunks-1 end tracer))
1815 (when (and end chunk (featurep 'mumamo-regions))
1816 (setq region-info (mumamo-get-region-from end))
1817 ;;(msgtrc "find-chunks:region-info=%s" region-info)
1818 (if (overlayp region-info)
1819 (setq chunk region-info)
1820 ;;(overlay-put chunk 'obscured (list end region-info))))
1821 (mumamo-put-obscure chunk end region-info)))
1822 ;;(msgtrc "find-chunks ret chunk=%s" chunk)
1825 (defun mumamo-move-to-old-tail (first-check-from)
1826 "Divide the chunk list.
1827 Make it two parts. The first, before FIRST-CHECK-FROM is still
1828 correct but we want to check those after. Put thosie in
1831 (while (and (mumamo-while 500 'while-n0 "mumamo-last-chunk first-check-from")
1834 (< first-check-from (overlay-end mumamo-last-chunk)))
1835 (overlay-put mumamo-last-chunk 'mumamo-next-chunk mumamo-old-tail)
1836 (setq mumamo-old-tail mumamo-last-chunk)
1837 (overlay-put mumamo-old-tail 'mumamo-is-new nil)
1838 (when nil ;; For debugging
1839 (overlay-put mumamo-old-tail
1842 (format "red%d" (overlay-get mumamo-old-tail 'mumamo-depth)))))
1843 (setq mumamo-last-chunk
1844 (overlay-get mumamo-last-chunk 'mumamo-prev-chunk)))))
1846 (defun mumamo-delete-empty-chunks-at-end ()
1847 ;; fix-me: later? Delete empty chunks at end, will be recreated if really needed
1849 (while (and (mumamo-while 500 'while-n1 "mumamo-last-chunk del empty chunks")
1851 ;;(= (point-max) (overlay-end mumamo-last-chunk))
1852 (= (overlay-end mumamo-last-chunk) (overlay-start mumamo-last-chunk)))
1853 ;;(msgtrc "delete-overlay at end")
1854 (delete-overlay mumamo-last-chunk)
1855 (setq mumamo-last-chunk (overlay-get mumamo-last-chunk 'mumamo-prev-chunk))
1856 (when mumamo-last-chunk (overlay-put mumamo-last-chunk 'mumamo-next-chunk nil)))))
1859 (defun mumamo-delete-chunks-upto (ok-pos)
1860 "Delete old chunks upto OK-POS."
1861 (or (not mumamo-old-tail)
1862 (overlay-buffer mumamo-old-tail)
1863 (setq mumamo-old-tail nil))
1865 (while (and (mumamo-while 500 'while-n2 "mumamo-old-tail")
1866 (and mumamo-old-tail (< (overlay-start mumamo-old-tail) ok-pos)))
1867 (mumamo-mark-for-refontification (overlay-start mumamo-old-tail) (overlay-end mumamo-old-tail))
1868 ;;(msgtrc "find-chunks:ok-pos=%s, not eq delete %s" ok-pos mumamo-old-tail)
1869 (delete-overlay mumamo-old-tail)
1870 (setq mumamo-old-tail (overlay-get mumamo-old-tail 'mumamo-next-chunk))
1871 (or (not mumamo-old-tail)
1872 (overlay-buffer mumamo-old-tail)
1873 (setq mumamo-old-tail nil)))))
1875 (defun mumamo-reuse-old-tail-head ()
1876 ;;(msgtrc "reusing %S" mumamo-old-tail)
1877 (setq mumamo-last-chunk mumamo-old-tail)
1878 (overlay-put mumamo-last-chunk 'mumamo-is-new t)
1879 (mumamo-clear-chunk-ppss-cache mumamo-last-chunk)
1880 (overlay-put mumamo-last-chunk 'face (mumamo-background-color (overlay-get mumamo-last-chunk 'mumamo-depth)))
1881 (setq mumamo-old-tail (overlay-get mumamo-old-tail 'mumamo-next-chunk)))
1883 (defun mumamo-old-tail-fits (this-new-values)
1884 (and mumamo-old-tail
1885 (overlay-buffer mumamo-old-tail)
1886 (mumamo-new-chunk-equal-chunk-values mumamo-old-tail this-new-values)))
1888 (defun mumamo-find-chunks-1 (end tracer) ;; min max)
1889 ;; Note: This code must probably be reentrant. The globals changed
1890 ;; here are `mumamo-last-chunk' and `mumamo-old-tail'. They must be
1891 ;; handled as a pair.
1892 (mumamo-msgfntfy "")
1893 (setq mumamo-find-chunks-level (1+ mumamo-find-chunks-level))
1894 (unless (and (overlayp mumamo-last-chunk) (overlay-buffer mumamo-last-chunk)) (setq mumamo-last-chunk nil))
1897 (let* ((mumamo-find-chunks-1-active t)
1900 (change-min (car mumamo-last-change-pos))
1901 (change-max (cdr mumamo-last-change-pos))
1902 (chunk-at-change-min (when change-min (mumamo-get-existing-new-chunk-at change-min nil)))
1903 (chunk-at-change-min-start (when chunk-at-change-min (overlay-start chunk-at-change-min)))
1904 ;; Check if change is near border
1905 (this-syntax-min-max
1906 (when chunk-at-change-min
1907 (mumamo-update-obscure chunk-at-change-min chunk-at-change-min-start)
1908 (mumamo-chunk-syntax-min-max chunk-at-change-min nil)))
1909 (this-syntax-min (car this-syntax-min-max))
1910 (in-min-border (when this-syntax-min (>= this-syntax-min change-min)))
1911 (first-check-from (if chunk-at-change-min
1912 (if (or in-min-border
1914 (> 20 (- change-min chunk-at-change-min-start)))
1916 (- chunk-at-change-min-start 1))
1917 chunk-at-change-min-start)
1919 (goto-char change-min)
1920 (skip-chars-backward "^\n")
1921 (unless (bobp) (backward-char))
1922 (prog1 (point) (goto-char here))))))
1923 (when (and chunk-at-change-min (= 0 (- (overlay-end chunk-at-change-min)
1924 (overlay-start chunk-at-change-min))))
1925 (assert in-min-border)) ;; 0 len must be in border
1926 (setq mumamo-last-change-pos nil)
1927 (when chunk-at-change-min
1928 (mumamo-move-to-old-tail first-check-from)
1929 (mumamo-delete-empty-chunks-at-end))
1930 ;; Now mumamo-last-chunk is the last in the top chain and
1931 ;; mumamo-old-tail the first in the bottom chain.
1934 ;;(last-chunk-is-closed (when mumamo-last-chunk (overlay-get mumamo-last-chunk 'mumamo-is-closed)))
1935 (last-chunk-is-closed t)
1936 (ok-pos (or (and mumamo-last-chunk
1937 (- (overlay-end mumamo-last-chunk)
1938 ;;(or (and last-chunk-is-closed 1)
1939 (or (and (/= (overlay-end mumamo-last-chunk)
1945 (end (or end (point-max)))
1952 (when (>= ok-pos end)
1953 (setq this-new-chunk (mumamo-get-existing-new-chunk-at end nil))
1954 (unless this-new-chunk
1955 (error "Could not find new chunk ok-pos-new=%s > end=%s (ovls at end=%s), level=%d, old-tail=%s, %S"
1956 ok-pos end (overlays-in end end)
1957 mumamo-find-chunks-level mumamo-old-tail tracer)))
1958 (unless this-new-chunk
1960 (unless mumamo-find-chunk-is-active
1961 ;;(setq mumamo-find-chunk-is-active t)
1962 (mumamo-stop-find-chunks-timer)
1963 (mumamo-save-buffer-state nil
1966 ;; Loop forward until end or buffer end ...
1967 (while (and (mumamo-while 1500 'while-n3 "until end")
1970 ;;(prog1 t (msgtrc "ok-pos=%s in while" ok-pos))
1971 (< ok-pos (point-max))
1972 (not (setq interrupted (and (not end)
1973 (input-pending-p)))))
1974 ;; Narrow to speed up. However the chunk divider may be
1975 ;; before ok-pos here. Assume that the marker is not
1976 ;; longer than 200 chars. fix-me.
1977 (narrow-to-region (max (- ok-pos 200) 1)
1979 ;; If this was after a change within one chunk then tell that:
1980 (let ((use-change-max (when (and change-max
1982 (overlay-buffer chunk-at-change-min)
1984 (overlay-end chunk-at-change-min))
1985 (or (not mumamo-last-chunk)
1986 (> change-max (overlay-end mumamo-last-chunk))))
1988 (use-chunk-at-change-min (when (or (not mumamo-last-chunk)
1989 (not (overlay-buffer mumamo-last-chunk))
1990 (not chunk-at-change-min)
1991 (not (overlay-buffer chunk-at-change-min))
1992 (> (overlay-end chunk-at-change-min)
1993 (overlay-end mumamo-last-chunk)))
1996 (setq this-new-values (mumamo-find-next-chunk-values
2000 use-chunk-at-change-min)))
2001 (if (not this-new-values)
2002 (setq ok-pos (point-max))
2003 (setq first-check-from nil)
2004 (setq ok-pos (or (mumamo-new-chunk-value-max this-new-values) ;;(overlay-end this-chunk)
2006 ;;(msgtrc "ok-pos=%s, point-max=%s max=%s" ok-pos (point-max) (mumamo-new-chunk-value-max this-new-values))
2007 ;; With the new organization all chunks are created here.
2008 (if (mumamo-old-tail-fits this-new-values)
2009 (mumamo-reuse-old-tail-head)
2010 (mumamo-delete-chunks-upto ok-pos)
2011 ;; Create chunk and chunk links
2012 (setq mumamo-last-chunk (mumamo-new-create-chunk this-new-values))
2013 ;;(setq last-chunk-is-closed (overlay-get mumamo-last-chunk 'mumamo-is-closed))
2014 (unless first-change-pos
2015 (setq first-change-pos (mumamo-new-chunk-value-min this-new-values))))))
2016 (setq this-new-chunk mumamo-last-chunk)))
2018 (when (or interrupted
2019 (and mumamo-last-chunk
2020 (overlayp mumamo-last-chunk)
2021 (overlay-buffer mumamo-last-chunk)
2022 (buffer-live-p (overlay-buffer mumamo-last-chunk))
2023 (< (overlay-end mumamo-last-chunk) (point-max))))
2024 (mumamo-start-find-chunks-timer)
2026 (when first-change-pos
2027 (setq jit-lock-context-unfontify-pos
2028 (if jit-lock-context-unfontify-pos
2029 (min jit-lock-context-unfontify-pos first-change-pos)
2030 first-change-pos))))
2032 (setq mumamo-find-chunk-is-active nil)))
2034 ;; fix-me: continue here
2035 (when chunk-at-change-min (mumamo-clear-chunk-ppss-cache chunk-at-change-min))
2036 (setq mumamo-find-chunks-level (1- mumamo-find-chunks-level))
2037 ;; Avoid empty overlays at the end of the buffer. Those can
2038 ;; come from for example deleting to the end of the buffer.
2039 (when this-new-chunk
2040 ;; Fix-me: can this happen now?
2041 (setq prev-chunk (overlay-get this-new-chunk 'mumamo-prev-chunk))
2042 (when (and prev-chunk
2043 (overlay-buffer prev-chunk)
2044 (= (overlay-start this-new-chunk) (overlay-end this-new-chunk))
2045 (= (overlay-start prev-chunk) (overlay-end prev-chunk)))
2046 (overlay-put prev-chunk 'mumamo-next-chunk nil)
2047 (overlay-put prev-chunk 'mumamo-prev-chunk nil)
2048 ;;(msgtrc "find-chunks:deleting this-new-chunk %s" this-new-chunk)
2049 (delete-overlay this-new-chunk)
2050 (setq this-new-chunk prev-chunk)
2052 (while (and mumamo-old-tail
2053 (overlay-buffer mumamo-old-tail)
2054 (= (overlay-start mumamo-old-tail) (overlay-end mumamo-old-tail)))
2055 (assert (not (eq mumamo-old-tail (overlay-get mumamo-old-tail 'mumamo-next-chunk))) t)
2056 (setq prev-chunk mumamo-old-tail)
2057 (setq mumamo-old-tail (overlay-get mumamo-old-tail 'mumamo-next-chunk))
2058 ;;(msgtrc "mumamo-find-chunks-1:after mumamo-old-tail=%s" mumamo-old-tail)
2059 (delete-overlay prev-chunk)
2062 ;;(unless (overlay-get mumamo-last-chunk 'mumamo-is-closed)
2063 (unless t ;(= (overlay-end mumamo-last-chunk) (save-restriction (widen) (point-max)))
2064 ;; Check that there are no left-over old chunks
2067 (dolist (o (overlays-in (point-min) (point-max)))
2068 (when (and (overlay-get o 'mumamo-depth)
2069 (not (overlay-get o 'mumamo-is-new)))
2070 (error "mumamo-find-chunks: left over chunk: %s end=%s, last-chunk=%s" o end mumamo-last-chunk)))))
2072 ;;(msgtrc "find-chunks:Exit.end-param=%s, this-new-chunk=%s, point-max=%s, last=%s" end-param this-new-chunk (point-max) mumamo-last-chunk)
2073 (let* ((ret this-new-chunk)
2074 (ret-beg (overlay-start ret))
2075 (ret-end (overlay-end ret)))
2076 (unless (and (<= ret-beg end-param)
2077 (<= end-param ret-end))
2078 (error "mumamo-find-chunks: Bad ret=%s, end=%s" ret end-param))
2079 ;;(msgtrc "find-chunks=>%S" ret)
2082 (defun mumamo-find-chunk-after-change (min max)
2083 "Save change position after a buffer change.
2084 This should be run after a buffer change. For MIN see
2085 `after-change-functions'."
2086 ;; Fix-me: Maybe use a list of all min, max instead?
2087 (mumamo-start-find-chunks-timer)
2088 ;;(msgtrc "(mumamo-find-chunk-after-change %s %s)" min max)
2089 (setq min (copy-marker min nil))
2090 (setq max (copy-marker max t))
2091 (setq mumamo-last-change-pos
2092 (if mumamo-last-change-pos
2093 (let* ((old-min (car mumamo-last-change-pos))
2094 (old-max (cdr mumamo-last-change-pos))
2095 (new-min (min min old-min))
2096 (new-max (max max old-max)))
2097 (cons new-min new-max))
2100 (defun mumamo-after-change (min max old-len)
2101 "Everything that needs to be done in mumamo after a change.
2102 This is run in the `after-change-functions' hook. For MIN, MAX
2103 and OLD-LEN see that variable."
2104 ;;(msgtrc "mumamo-after-change BEGIN min/max/old-len=%s/%s/%s" min max old-len)
2105 ;;(msgtrc "mumamo-after-change BEGIN")
2106 (mumamo-find-chunk-after-change min max)
2107 (mumamo-jit-lock-after-change min max old-len)
2108 (mumamo-msgfntfy "mumamo-after-change EXIT")
2109 ;;(msgtrc "mumamo-after-change EXIT mumamo-last-change-pos=%s" mumamo-last-change-pos)
2112 (defun mumamo-jit-lock-after-change (min max old-len)
2113 ;; Fix-me: Should not this be on
2114 ;; jit-lock-after-change-externd-region-functions??
2115 "Replacement for `jit-lock-after-change'.
2116 Does the nearly the same thing as that function, but takes
2117 care of that there might be different major modes at MIN and MAX.
2118 It also marks for refontification only in the current mumamo chunk.
2120 OLD-LEN is the pre-change length.
2122 Jit-lock after change functions is organized this way:
2124 `jit-lock-after-change' (doc: Mark the rest of the buffer as not
2125 fontified after a change) is added locally to the hook
2126 `after-change-functions'. This function runs
2127 `jit-lock-after-change-extend-region-functions'."
2128 (when (and jit-lock-mode (not memory-full))
2129 (mumamo-msgfntfy "mumamo-jit-lock-after-change ENTER %s %s %s" min max old-len)
2130 ;; Why is this nil?:
2131 (mumamo-msgfntfy " mumamo-jit-lock-after-change: font-lock-extend-after-change-region-function=%s" font-lock-extend-after-change-region-function)
2132 (let* ((ovl-min (mumamo-get-existing-new-chunk-at min nil))
2133 (ovl-max (when (or (not ovl-min)
2134 (< (overlay-end ovl-min) max))
2135 (mumamo-get-existing-new-chunk-at max nil)))
2136 (major-min (when ovl-min (mumamo-chunk-major-mode ovl-min)))
2137 (major-max (when ovl-max (mumamo-chunk-major-mode ovl-max)))
2142 (if (and major-min (eq major-min major-max))
2145 (mumamo-jit-lock-after-change-1 min max old-len major-min)))
2148 (mumamo-jit-lock-after-change-1 min max old-len major-min)))
2151 (mumamo-jit-lock-after-change-1 min max old-len major-max))))
2152 (mumamo-msgfntfy "mumamo-jit-lock-after-change r-min,max=%s,%s major-min,max=%s,%s" r-min r-max major-min major-max)
2154 (setq new-min (min new-min (car r-min)))
2155 (setq new-max (max new-max (cdr r-min))))
2157 (setq new-min (min new-min (car r-max)))
2158 (setq new-max (max new-max (cdr r-max))))
2159 (setq new-min (max new-min (point-min)))
2160 (setq new-max (min new-max (point-max)))
2161 ;; Make sure we change at least one char (in case of deletions).
2162 (setq new-max (min (max new-max (1+ new-min)) (point-max)))
2163 (mumamo-msgfntfy "mumamo-jit-lock-after-change new-min,max=%s,%s" new-min new-max)
2164 (mumamo-mark-for-refontification new-min new-max)
2166 ;; Mark the change for deferred contextual refontification.
2167 ;;(setq jit-lock-context-unfontify-pos nil) (setq message-log-max t)
2168 (when jit-lock-context-unfontify-pos
2169 (setq jit-lock-context-unfontify-pos
2170 ;; Here we use `start' because nothing guarantees that the
2171 ;; text between start and end will be otherwise refontified:
2172 ;; usually it will be refontified by virtue of being
2173 ;; displayed, but if it's outside of any displayed area in the
2174 ;; buffer, only jit-lock-context-* will re-fontify it.
2175 (min jit-lock-context-unfontify-pos new-min))
2176 ;;(with-current-buffer (get-buffer "*Messages*") (erase-buffer))
2177 (mumamo-msgfntfy "mumamo-jit-lock-after-change EXIT unfontify-pos=%s" jit-lock-context-unfontify-pos)
2178 ;;(message "mumamo-jit-lock-after-change.unfontify-pos=%s" jit-lock-context-unfontify-pos)
2180 ;;(min jit-lock-context-unfontify-pos jit-lock-start))))))
2181 ;;(put 'mumamo-jit-lock-after-change 'permanent-local-hook t)
2182 (put 'mumamo-after-change 'permanent-local-hook t)
2184 (defun mumamo-jit-lock-after-change-1 (min max old-len major)
2185 "Extend the region the same way jit-lock does it.
2186 This function tries to extend the region between MIN and MAX the
2187 same way jit-lock does it after a change. OLD-LEN is the
2190 The extending of the region is done as if MAJOR was the major
2192 (mumamo-with-major-mode-fontification major
2194 (let ((jit-lock-start ,min)
2195 (jit-lock-end ,max))
2196 ;;(mumamo-msgfntfy "mumamo-mumamo-jit-lock-after-change-1 jlacer=%s" ,jit-lock-after-change-extend-region-functions)
2197 (mumamo-with-buffer-prepared-for-jit-lock
2198 ;;(font-lock-extend-jit-lock-region-after-change ,min ,max ,old-len)
2199 (run-hook-with-args 'jit-lock-after-change-extend-region-functions min max old-len)
2200 ;;(setq jit-lock-end (min (max jit-lock-end (1+ min)) (point-max)))
2202 ;;; ;; Just run the buffer local function:
2203 ;;; (dolist (extend-fun jit-lock-after-change-extend-region-functions)
2204 ;;; (when (fboundp extend-fun)
2205 ;;; (funcall extend-fun ,min ,max ,old-len)))
2207 (setq min jit-lock-start)
2208 (setq max jit-lock-end)
2209 ;;(syntax-ppss-flush-cache min)
2211 (mumamo-msgfntfy "mumamo-mumamo-jit-lock-after-change-1 EXIT %s" (cons min max))
2214 (defun mumamo-mark-chunk ()
2215 "Mark chunk and move point to beginning of chunk."
2217 (let ((chunk (mumamo-find-chunks (point) "mumamo-mark-chunk")))
2218 (unless chunk (error "There is no MuMaMo chunk here"))
2219 (goto-char (overlay-start chunk))
2220 (push-mark (overlay-end chunk) t t)))
2222 (defun mumamo-narrow-to-chunk-inner ()
2224 (let* ((chunk (mumamo-find-chunks (point) "mumamo-narrow-to-chunk-innner"))
2225 (syntax-min-max (mumamo-chunk-syntax-min-max chunk t))
2226 (syntax-min (car syntax-min-max))
2227 (syntax-max (cdr syntax-min-max)))
2228 (narrow-to-region syntax-min syntax-max)))
2232 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
2233 ;;;; Font lock functions
2235 (defadvice hi-lock-set-pattern (around use-overlays activate)
2236 (if mumamo-multi-major-mode
2237 (let ((font-lock-fontified nil))
2242 (defun mumamo-mark-for-refontification (min max)
2243 "Mark region between MIN and MAX for refontification."
2244 ;;(msgtrc "mark-for-refontification A min,max=%s,%s point-min,max=%s,%s modified=%s" min max (point-min) (point-max) (buffer-modified-p) )
2245 ;;(mumamo-backtrace "mark-for-refontification")
2246 (mumamo-msgfntfy "mumamo-mark-for-refontification A min,max=%s,%s point-min,max=%s,%s modified=%s" min max (point-min) (point-max) (buffer-modified-p) )
2247 (assert (<= min max))
2251 (mumamo-msgfntfy "mumamo-mark-for-refontification B min,max=%s,%s point-min,max=%s,%s modified=%s" min max (point-min) (point-max) (buffer-modified-p) )
2252 ;;(mumamo-with-buffer-prepared-for-jit-lock
2253 (mumamo-save-buffer-state nil
2254 (put-text-property min max 'fontified nil)
2258 ;; Fix me: The functions in this list must be replaced by variables
2259 ;; pointing to anonymous functions for buffer local values of
2260 ;; fontification keywords to be supported. And that is of course
2261 ;; necessary for things like hi-lock etc. (Or..., perhaps some kind of
2262 ;; with-variable-values... as RMS suggested once... but that will not
2265 ;; Seems like font-lock-add-keywords must be advised...
2266 (defvar mumamo-internal-major-modes-alist nil
2267 "Alist with info for different major modes.
2268 Internal use only. This is automatically set up by
2269 `mumamo-get-major-mode-setup'.")
2270 (setq mumamo-internal-major-modes-alist nil)
2271 (put 'mumamo-internal-major-modes-alist 'permanent-local t)
2273 (defvar mumamo-ppss-last-chunk nil
2274 "Internal variable used to avoid unnecessary flushing.")
2275 (defvar mumamo-ppss-last-major nil
2276 "Internal variable used to avoid unnecessary flushing.")
2278 ;;(mumamo-get-major-mode-substitute 'nxhtml-mode 'fontification)
2279 ;;(mumamo-get-major-mode-substitute 'nxhtml-mode 'indentation)
2280 ;;(mumamo-get-major-mode-substitute 'css-mode 'fontification)
2281 ;;(mumamo-get-major-mode-substitute 'css-mode 'indentation)
2282 ;; (assq 'nxml-mode mumamo-major-mode-substitute)
2283 (defconst mumamo-major-mode-substitute
2285 (nxhtml-mode (html-mode nxhtml-mode))
2286 ;;(nxhtml-mode (html-mode))
2287 (nxhtml-genshi-mode (html-mode nxhtml-mode))
2288 (nxhtml-mjt-mode (html-mode nxhtml-mode))
2289 (nxml-mode (sgml-mode))
2291 "Major modes substitute to use for fontification and indentation.
2292 The entries in this list has either of the formats
2294 \(MAJOR (FONT-MODE INDENT-MODE))
2295 \(MAJOR (FONT-MODE))
2297 where major is the major mode in a mumamo chunk and FONT-MODE is
2298 the major mode for fontification of that chunk and INDENT-MODE is
2299 dito for indentation. In the second form the same mode is used
2300 for indentation as for fontification.")
2302 ;;(mumamo-get-major-mode-substitute 'nxhtml-mode 'indentation)
2303 ;;(mumamo-get-major-mode-substitute 'nxhtml-mode 'fontification)
2304 (defun mumamo-get-major-mode-substitute (major for-what)
2305 "For major mode MAJOR return major mode to use for FOR-WHAT.
2306 FOR-WHAT can be either 'fontification or indentation.
2308 mumamo must handle fontification and indentation for `major-mode'
2309 by using other major mode if the functions for this in
2310 `major-mode' are not compatible with mumamo. This functions
2311 looks in the table `mumamo-major-mode-substitute' for get major
2313 ;;(when (eq for-what 'indentation) (message "subst.major=%s" major))
2314 (let ((m (assq major mumamo-major-mode-substitute))
2317 (setq ret-major major)
2321 ((eq for-what 'fontification)
2323 ((eq for-what 'indentation)
2326 (mumamo-display-error 'mumamo-get-major-mode-substitute
2327 "Bad parameter, for-what=%s" for-what))))
2328 (unless ret-major (setq ret-major major)))
2329 (unless (commandp ret-major) (setq ret-major 'mumamo-bad-mode))
2330 ;;(when (eq for-what 'indentation) (message "ret.ind=%s, major=%s, m=%s" ret major m))
2333 (defun mumamo-assert-fontified-t (start end)
2334 "Assert that the region START to END has 'fontified t."
2335 (let ((start-ok (get-text-property start 'fontified))
2337 (next-single-property-change (1+ start) 'fontified nil end)))
2338 (when (not start-ok)
2339 (message "==== mumamo-assert-fontified-t %s-%s start not ok" start end))
2340 (when (not (= first-not-ok end))
2341 (message "==== mumamo-assert-fontified-t %s-%s first not ok=%s" start end first-not-ok))))
2343 ;; Keep this separate for easier debugging.
2344 (defun mumamo-do-fontify (start end verbose chunk-syntax-min chunk-syntax-max chunk-major)
2345 "Fontify region between START and END.
2346 If VERBOSE is non-nil then print status messages during
2349 CHUNK-SYNTAX-MIN, CHUNK-SYNTAX-MAX and CHUNK-MAJOR are the
2350 chunk's min point, max point and major mode.
2352 During fontification narrow the buffer to the chunk to make
2353 syntactic fontification work. If chunks starts or end with \"
2354 then the first respective last char then exclude those chars from
2355 from the narrowed part, since otherwise the syntactic
2356 fontification can't find out where strings start and stop.
2358 Note that this function is run under
2359 `mumamo-with-major-mode-fontification'.
2361 This function takes care of `font-lock-dont-widen' and
2362 `font-lock-extend-region-functions'. Normally
2363 `font-lock-default-fontify-region' does this, but that function
2364 is not called when mumamo is used!
2366 PS: `font-lock-fontify-syntactically-region' is the main function
2367 that does syntactic fontification."
2368 ;;(msgtrc "mumamo-do-fontify enter: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
2369 ;;(msgtrc "mumamo-do-fontify <<<<<<< %s %s %s %s %s %s" start end verbose chunk-syntax-min chunk-syntax-max chunk-major)
2370 ;;(msgtrc "font-lock-keywords=%S" font-lock-keywords)
2371 ;;(mumamo-assert-fontified-t start end)
2372 (mumamo-condition-case err
2373 (let* ((font-lock-dont-widen t)
2374 (font-lock-extend-region-functions
2376 font-lock-extend-region-functions
2378 ;; Extend like in `font-lock-default-fontify-region':
2379 (funs font-lock-extend-region-functions)
2380 (font-lock-beg (max chunk-syntax-min start))
2381 (font-lock-end (min chunk-syntax-max end))
2383 ;;(while (and (> 500 (setq while-n1 (1+ while-n1)))
2384 (while (and (mumamo-while 500 'while-n1 "funs")
2386 (setq funs (if (or (not (funcall (car funs)))
2387 (eq funs font-lock-extend-region-functions))
2389 ;; If there's been a change, we should go through
2390 ;; the list again since this new position may
2391 ;; warrant a different answer from one of the fun
2392 ;; we've already seen.
2393 font-lock-extend-region-functions)))
2394 ;; But we must restrict to the chunk here:
2395 (let ((new-start (max chunk-syntax-min font-lock-beg))
2396 (new-end (min chunk-syntax-max font-lock-end)))
2397 ;;(msgtrc "do-fontify %s %s, chunk-syntax-min,max=%s,%s, new: %s %s" start end chunk-syntax-min chunk-syntax-max new-start new-end)
2398 ;; A new condition-case just to catch errors easier:
2399 (when (< new-start new-end)
2400 (mumamo-condition-case err
2402 ;;(when (and (>= 625 (point-min)) (<= 625 (point-max))) (msgtrc "multi at 625=%s" (get-text-property 625 'font-lock-multiline)))
2403 ;;(msgtrc "(narrow-to-region %s %s)" chunk-syntax-min chunk-syntax-max)
2404 (when (< chunk-syntax-min chunk-syntax-max)
2405 (narrow-to-region chunk-syntax-min chunk-syntax-max)
2406 ;; Now call font-lock-fontify-region again but now
2407 ;; with the chunk font lock parameters:
2408 (setq font-lock-syntactically-fontified (1- new-start))
2409 (mumamo-msgfntfy "ENTER font-lock-fontify-region %s %s %s" new-start new-end verbose)
2410 ;;(msgtrc "mumamo-do-fontify: font-lock-keywords-only =%s in buffer %s, def=%s" font-lock-keywords-only (current-buffer) (default-value 'font-lock-keywords-only))
2411 (let (font-lock-extend-region-functions)
2412 (font-lock-fontify-region new-start new-end verbose))
2413 (mumamo-msgfntfy "END font-lock-fontify-region %s %s %s" new-start new-end verbose)
2417 (mumamo-display-error 'mumamo-do-fontify-2
2418 "mumamo-do-fontify m=%s, s/e=%s/%s syn-min/max=%s/%s: %s"
2421 chunk-syntax-min chunk-syntax-max
2422 (error-message-string err)))))))
2424 (mumamo-display-error 'mumamo-do-fontify
2425 "mumamo-do-fontify m=%s, s=%s, e=%s: %s"
2426 chunk-major start end (error-message-string err)))
2428 (mumamo-msgfntfy "mumamo-do-fontify exit >>>>>>> %s %s %s %s %s %s" start end verbose chunk-syntax-min chunk-syntax-max chunk-major)
2429 ;;(msgtrc "mumamo-do-fontify exit: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
2432 (defun mumamo-do-unfontify (start end)
2433 "Unfontify region between START and END."
2434 (mumamo-condition-case err
2435 (font-lock-unfontify-region start end)
2437 (mumamo-display-error 'mumamo-do-unfontify "%s"
2438 (error-message-string err)))))
2440 (defun mumamo-fontify-region-with (start end verbose major chunk-syntax-min chunk-syntax-max)
2441 "Fontify from START to END.
2442 If VERBOSE is non-nil then print status messages during
2445 Do the fontification as in major mode MAJOR.
2447 Narrow to region CHUNK-SYNTAX-MIN and CHUNK-SYNTAX-MAX during
2449 ;; The text property 'fontified is always t here due to the way
2452 ;;(msgtrc "fontify-region-with %s %s %s %s, ff=%s" start end verbose major (get-text-property start 'fontified))
2453 ;;(mumamo-assert-fontified-t start end)
2454 ;;(msgtrc "mumamo-fontify-region-with enter: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
2455 (mumamo-condition-case err
2457 ;;(msgtrc "mumamo-fontify-region-with: font-lock-keywords-only =%s in buffer %s, def=%s" font-lock-keywords-only (current-buffer) (default-value 'font-lock-keywords-only))
2458 (mumamo-with-major-mode-fontification major
2459 `(mumamo-do-fontify ,start ,end ,verbose ,chunk-syntax-min ,chunk-syntax-max major))
2462 (mumamo-display-error 'mumamo-fontify-region-with "%s"
2463 (error-message-string err))))
2464 ;;(msgtrc "mumamo-fontify-region-with exit: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
2467 (defun mumamo-unfontify-region-with (start end major)
2468 "Unfontify from START to END as in major mode MAJOR."
2469 (mumamo-msgfntfy "mumamo-unfontify-region-with %s %s %s, ff=%s"
2476 (get-text-property start 'fontified))))
2477 (mumamo-with-major-mode-fontification major
2478 `(mumamo-do-unfontify ,start ,end)))
2482 (defun mumamo-backtrace (label)
2483 (msgtrc "%s:backtrace in START buffer %s <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n%s"
2484 label (current-buffer) (with-output-to-string (backtrace)))
2485 (msgtrc "%s:backtrace in END buffer %s >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>" label (current-buffer)))
2487 (defun mumamo-unfontify-buffer ()
2489 This function is called when the minor mode function
2490 `font-lock-mode' is turned off. \(It is the value of
2491 `font-lock-unfontify-uffer-function')."
2492 (when (and mumamo-multi-major-mode
2493 (not (and (boundp 'mumamo-find-chunks-1-active)
2494 mumamo-find-chunks-1-active)))
2495 ;;(mumamo-backtrace "unfontify-buffer")
2496 ;;(msgtrc "mumamo-unfontify-buffer:\n%s" (with-output-to-string (backtrace)))
2500 (let ((ovls (overlays-in (point-min) (point-max)))
2501 (main-major (mumamo-main-major-mode)))
2503 (when (overlay-get o 'mumamo-is-new)
2504 (let ((major (mumamo-chunk-major-mode o)))
2506 (unless (mumamo-fun-eq major main-major)
2507 (mumamo-unfontify-chunk o))
2508 ;;(msgtrc "delete-overlay 1")
2511 (mumamo-unfontify-region-with (point-min) (point-max)
2512 (mumamo-main-major-mode)))))))
2515 (defun mumamo-fontify-buffer ()
2516 "For `font-lock-fontify-buffer-function' call.
2517 Not sure when this normally is done. However some functions call
2518 this to ensure that the whole buffer is fontified."
2519 (mumamo-msgfntfy "===> mumamo-fontify-buffer-function called")
2520 ;;(font-lock-default-fontify-buffer)
2521 (unless mumamo-set-major-running
2522 ;; This function is normally not called, but when new patterns
2523 ;; have been added by hi-lock it will be called. In this case we
2524 ;; need to make buffer local fontification variables:
2525 (set (make-local-variable 'mumamo-internal-major-modes-alist) nil)
2526 (jit-lock-refontify)))
2529 (defun mumamo-unfontify-chunk (chunk) ; &optional start end)
2530 "Unfontify mumamo chunk CHUNK."
2531 (let* ((major (mumamo-chunk-major-mode chunk))
2532 ;;(start (overlay-start chunk))
2533 ;;(end (overlay-end chunk))
2534 (syntax-min-max (mumamo-chunk-syntax-min-max chunk t))
2535 (syntax-min (car syntax-min-max))
2536 (syntax-max (cdr syntax-min-max))
2537 (font-lock-dont-widen t))
2538 (when (< syntax-min syntax-max)
2540 (narrow-to-region syntax-min syntax-max)
2541 (mumamo-unfontify-region-with syntax-min syntax-max major)))))
2543 (defun mumamo-fontify-region (start end &optional verbose)
2544 "Fontify between START and END.
2545 Take the major mode chunks into account while doing this.
2547 If VERBOSE do the verbously.
2549 The value of `font-lock-fontify-region-function' when
2550 mumamo is used is this function."
2551 (mumamo-msgfntfy "++++++ mumamo-fontify-regionX %s %s %s, skip=%s" start end verbose mumamo-just-changed-major)
2552 ;;(msgtrc "mumamo-fontify-region: font-lock-keywords-only =%s in buffer %s, def=%s" font-lock-keywords-only (current-buffer) (default-value 'font-lock-keywords-only))
2553 ;;(mumamo-assert-fontified-t start end)
2554 ;; If someone else tries to fontify the buffer ...
2555 (if (and mumamo-just-changed-major
2556 ;; The above variable is reset in `post-command-hook' so
2557 ;; check if we are in a recursive search. (Note: There are
2558 ;; other situation when this can occur. It might be best to
2559 ;; remove this test later, or make it optional.)
2561 ;; skip the test for now:
2563 (= 0 (recursion-depth)))
2564 (mumamo-display-error 'mumamo-fontify-region
2565 "Just changed major, should not happen")
2566 (mumamo-condition-case err
2567 (mumamo-fontify-region-1 start end verbose)
2569 (mumamo-display-error 'mumamo-fontify-region "%s"
2570 (error-message-string err))))))
2572 (defconst mumamo-dbg-pretend-fontified nil
2573 "Set this to t to be able to debug more easily.
2574 This is for debugging `mumamo-fontify-region-1' more easily by
2575 just calling it. It will make that function believe that the text
2576 has a non-nil 'fontified property.")
2578 (defun mumamo-exc-mode (chunk)
2579 "Return sub major mode for CHUNK.
2580 If chunk is a main major mode chunk return nil, otherwise return
2581 the major mode for the chunk."
2582 (let ((major (mumamo-chunk-major-mode chunk)))
2583 (unless (mumamo-fun-eq major (mumamo-main-major-mode))
2586 ;;; Chunk in chunk needs push/pop relative prev chunk
2587 (defun mumamo-chunk-push (chunk prop val)
2588 (let* ((prev-chunk (overlay-get chunk 'mumamo-prev-chunk))
2589 (prev-val (when prev-chunk (overlay-get prev-chunk prop))))
2590 (overlay-put chunk prop (cons val prev-val))))
2591 (defun mumamo-chunk-pop (chunk prop)
2592 (overlay-put chunk prop (cdr (overlay-get (overlay-get chunk 'mumamo-prev-chunk)
2595 ;; (defvar mumamo-chunks-to-remove nil
2596 ;; "Internal. Chunk overlays marked for removal.")
2597 ;; (make-variable-buffer-local 'mumamo-chunks-to-remove)
2599 (defun mumamo-flush-chunk-syntax (chunk chunk-min chunk-max)
2600 "Flush syntax cache for chunk CHUNK.
2601 This includes removing text property 'syntax-table between
2602 CHUNK-MIN and CHUNK-MAX."
2603 ;; syntax-ppss-flush-cache
2604 (overlay-put chunk 'syntax-ppss-last nil)
2605 (overlay-put chunk 'syntax-ppss-cache nil)
2606 (overlay-put chunk 'syntax-ppss-stats nil)
2607 (mumamo-save-buffer-state nil
2608 (remove-list-of-text-properties chunk-min chunk-max '(syntax-table))))
2610 ;; Fix-me: If I open nxhtml-changes.html and then go to the bottom of
2611 ;; the file at once syntax-ppss seems to be upset. It is however cured
2612 ;; by doing some change above the region that is badly fontified.
2613 (defun mumamo-fontify-region-1 (start end verbose)
2614 "Fontify region between START and END.
2615 If VERBOSE is non-nil then print status messages during
2618 This is called from `mumamo-fontify-region' which is the value of
2619 `font-lock-fontify-region-function' when mumamo is used. \(This
2620 means that it ties into the normal font lock framework in Emacs.)
2622 Note: The purpose of extracting this function from
2623 `mumamo-fontify-region' \(which is the only place where it is
2624 called) is to make debugging easier. Edebug will without this
2625 function just step over the `condition-case' in
2626 `mumamo-fontify-region'.
2628 The fontification is done in steps:
2630 - First a mumamo chunk is found or created at the start of the
2631 region with `mumamo-get-chunk-at'.
2632 - Then this chunk is fontified according to the major mode for
2634 - If the chunk did not encompass the whole region then this
2635 procedure is repeated with the rest of the region.
2637 If some mumamo chunk in the region between START and END has been
2638 marked for removal \(for example by `mumamo-jit-lock-after-change') then
2639 they are removed by this function.
2641 For some main major modes \(see `define-mumamo-multi-major-mode') the
2642 main major modes is first used to fontify the whole region. This
2643 is because otherwise the fontification routines for that mode may
2644 have trouble finding the correct starting state in a chunk.
2646 Special care has been taken for chunks that are strings, ie
2647 surrounded by \"...\" since they are fontified a bit special in
2649 ;; Fix-me: unfontifying should be done using the correct syntax table etc.
2650 ;; Fix-me: refontify when new chunk
2651 ;;(msgtrc "fontify-region-1: font-lock-keywords-only =%s in buffer %s, def=%s" font-lock-keywords-only (current-buffer) (default-value 'font-lock-keywords-only))
2653 (let* ((old-point (point))
2655 (main-major (mumamo-main-major-mode))
2656 (fontified-t ;;(or mumamo-dbg-pretend-fontified
2657 ;; (get-text-property here 'fontified))
2659 after-change-functions ;; Fix-me: tested adding this to avoid looping
2662 (chunk-at-start-1 (mumamo-find-chunks start "mumamo-fontify-region-1"))
2665 (when chunk-at-start-1
2666 (unless (= start (1- (overlay-end chunk-at-start-1)))
2667 (setq chunk-at-start-1 nil)))
2668 ;;(while (and (> 500 (setq while-n1 (1+ while-n1)))
2669 (while (and (mumamo-while 9000 'while-n1 "fontified-t")
2672 ;;(msgtrc "mumamo-fontify-region-1 heree 1, here=%s, end=%s" here end)
2673 ;;(mumamo-assert-fontified-t here end)
2674 ;;(mumamo-assert-fontified-t start end)
2675 ;; Check where new chunks should be, adjust old chunks as
2676 ;; necessary. Refontify inside end-start and outside of
2677 ;; start-end mark for refontification when major-mode has
2678 ;; changed or there was no old chunk.
2680 ;; Fix-me: Join chunks!
2681 (let* ((chunk (mumamo-find-chunks here "mumamo-fontify-region-1 2"))
2682 (chunk-min (when chunk (overlay-start chunk)))
2683 (chunk-max (when chunk (overlay-end chunk)))
2684 (chunk-min-1 (when chunk (if (> chunk-min (point-min)) (1- chunk-min) (point-min))))
2685 (chunk-max-1 (when chunk (if (< chunk-max (point-max)) (1+ chunk-max) (point-max))))
2686 (chunk-min-face (when chunk (get-text-property chunk-min-1 'face)))
2687 (chunk-max-face (when chunk (get-text-property chunk-max-1 'face)))
2688 (chunk-major (when chunk (mumamo-chunk-major-mode chunk)))
2689 max ; (min chunk-max end))
2693 (setq chunk-min (when chunk (overlay-start chunk)))
2694 (setq chunk-max (when chunk (overlay-end chunk)))
2697 (if (> chunk-min (point-min)) (1- chunk-min) (point-min)))) ;chunk-min
2700 (if (< chunk-max (point-max)) (1+ chunk-max) (point-max)))) ;chunk-max
2701 (setq chunk-min-face
2702 (when chunk (get-text-property chunk-min-1 'face)))
2703 (setq chunk-max-face
2704 (when chunk (get-text-property chunk-max-1 'face)))
2705 (setq chunk-major (when chunk (mumamo-chunk-major-mode chunk)))
2707 (if (and first-new-ovl (overlay-buffer first-new-ovl))
2708 (setq last-new-ovl chunk)
2709 (setq last-new-ovl chunk)
2710 (setq first-new-ovl chunk))
2711 ;;(mumamo-assert-fontified-t chunk-min chunk-max)
2713 (setq max (min chunk-max end))
2715 (assert chunk) (assert (overlay-buffer chunk)) (assert chunk-min)
2716 (assert chunk-max) (assert chunk-major)
2717 ;; Fix-me: The next assertion sometimes fails. Could it be
2718 ;; that this loop is continuing even after a change in the
2719 ;; buffer? How do I stop that? When?:
2720 ;;(assert (or (= here start) (= here chunk-min)) nil "h=%s, s=%s, cm=%s-%s, e=%s, chunk-major=%s" here start chunk-min chunk-max end chunk-major)
2721 ;;(assert (not (mumamo-fun-eq prev-major chunk-major)))
2723 ;; (assert (= (overlay-end prev-chunk) (overlay-start chunk))))
2726 ;;(msgtrc "\nmumamo-fontify-region-1 before chunk=%s" chunk)
2727 (mumamo-update-obscure chunk here)
2728 (let* ((syntax-min-max (mumamo-chunk-syntax-min-max chunk nil))
2729 (syntax-min (car syntax-min-max))
2730 (syntax-max (cdr syntax-min-max))
2731 (chunk-min (overlay-start chunk))
2732 (chunk-max (overlay-end chunk))
2733 (border-min-max (mumamo-chunk-syntax-min-max chunk t))
2734 (border-min (car border-min-max))
2735 (border-max (cdr border-min-max))
2737 ;;(msgtrc "fontify-region-1:syntax-min-max=%S, chunk=%S" syntax-min-max chunk)
2738 ;;(msgtrc "chunk mumamo-border-face: %s" chunk)
2739 (mumamo-msgfntfy "mumamo-fontify-region-1, here=%s chunk-min=%s syn-mn/mx=%s/%s" here chunk-min syntax-min syntax-max)
2740 (when (<= here syntax-min)
2741 (mumamo-flush-chunk-syntax chunk syntax-min syntax-max))
2742 (when (and (<= here syntax-min)
2743 (< chunk-min border-min))
2744 ;;(msgtrc "face-in: %s-%s" chunk-min border-min)
2745 (put-text-property chunk-min border-min 'face 'mumamo-border-face-in)
2747 (when (and (<= chunk-max max)
2748 ;;(< (1+ border-max) chunk-max))
2749 (< border-max chunk-max))
2750 ;;(put-text-property (1+ border-max) chunk-max
2751 (put-text-property border-max chunk-max
2752 'face 'mumamo-border-face-out))
2753 (mumamo-fontify-region-with here max verbose chunk-major
2754 syntax-min syntax-max))
2756 ;;(setq prev-major chunk-major)
2757 ;;(setq prev-chunk chunk)
2758 (setq here (if (= max here) (1+ max) max))
2759 ;;(setq fontified-t (or mumamo-dbg-pretend-fontified (get-text-property (1- here) 'fontified)))
2761 ;;(msgtrc "ft here end=%s %s %s" fontified-t here end)
2763 (goto-char old-point)
2764 ;;(msgtrc "b first-new-ovl=%s last-new-ovl=%s" first-new-ovl last-new-ovl)
2766 ;; Fix-me: I am not sure what to do here. Probably just
2767 ;; refontify the rest between start and end. But does not
2768 ;; this lead to unnecessary refontification?
2769 ;;(msgtrc "not sure, here=%s, end=%s" here end)
2770 (unless (= here (point-max))
2771 (mumamo-mark-for-refontification here end)))
2773 ;;(msgtrc "EXIT mumamo-fontify-region-1")
2777 (defvar mumamo-known-buffer-local-fontifications
2783 hi-lock-file-patterns
2784 hi-lock-interactive-patterns
2785 wrap-to-fill-column-mode
2788 (defconst mumamo-irrelevant-buffer-local-vars
2790 ;; This list was fetched with
2791 ;; emacs-Q, fundamental-mode
2792 after-change-functions
2793 ;;auto-composition-function
2794 ;;auto-composition-mode
2795 ;;auto-composition-mode-major-mode
2796 buffer-auto-save-file-format
2797 buffer-auto-save-file-name
2799 buffer-display-count
2803 buffer-file-truename
2804 buffer-invisibility-spec
2808 change-major-mode-hook
2809 ;;char-property-alias-alist
2813 enable-multibyte-characters
2815 ;;font-lock-mode-major-mode
2821 ;; Handled by font lock etc
2825 ;;font-lock-keywords-only
2826 font-lock-keywords-case-fold-search
2828 ;;font-lock-mode-major-mode
2829 font-lock-set-defaults
2830 font-lock-syntax-table
2831 font-lock-beginning-of-syntax-function
2832 fontification-functions
2833 jit-lock-context-unfontify-pos
2836 font-lock-fontify-buffer-function
2837 jit-lock-contextually
2839 ;; More symbols from visual inspection
2840 before-change-functions
2843 line-move-ignore-invisible
2849 cua--explicit-region-start
2851 viper--intercept-key-maps
2853 viper-ALPHA-char-class
2855 viper-emacs-global-user-minor-mode
2856 viper-emacs-intercept-minor-mode
2857 viper-emacs-kbd-minor-mode
2858 viper-emacs-local-user-minor-mode
2859 viper-emacs-state-modifier-minor-mode
2860 viper-insert-basic-minor-mode
2861 viper-insert-diehard-minor-mode
2862 viper-insert-global-user-minor-mode
2863 viper-insert-intercept-minor-mode
2864 viper-insert-kbd-minor-mode
2865 viper-insert-local-user-minor-mode
2866 viper-insert-minibuffer-minor-mode
2868 viper-insert-state-modifier-minor-mode
2869 viper-intermediate-command
2870 viper-last-posn-while-in-insert-state
2871 viper-minibuffer-current-face
2873 viper-non-word-characters
2874 viper-replace-minor-mode
2875 viper-replace-overlay
2876 viper-undo-functions
2877 viper-undo-needs-adjustment
2878 viper-vi-basic-minor-mode
2879 viper-vi-diehard-minor-mode
2880 viper-vi-global-user-minor-mode
2881 viper-vi-intercept-minor-mode
2882 viper-vi-kbd-minor-mode
2883 viper-vi-local-user-minor-mode
2884 viper-vi-minibuffer-minor-mode
2885 viper-vi-state-modifier-minor-mode
2887 hs-adjust-block-beginning
2888 hs-block-start-mdata-select
2889 hs-block-start-regexp
2891 hs-forward-sexp-func
2894 imenu-case-fold-search
2895 imenu-generic-expression
2896 ;; Fix-me: add more here
2899 (defun mumamo-get-relevant-buffer-local-vars ()
2900 "Get list of buffer local variables to save.
2901 Like `buffer-local-variables', but remove variables that are
2902 known to not be necessary to save for fontification, indentation
2903 or filling \(or that can even disturb things)."
2905 (dolist (vv (buffer-local-variables))
2906 (unless (or (not (listp vv))
2907 (memq (car vv) mumamo-irrelevant-buffer-local-vars)
2908 (let* ((sym (car vv))
2909 (val (symbol-value sym)))
2912 (let ((ent (list (car vv) (custom-quote (cdr vv)))))
2913 (setq var-vals (cons ent var-vals)))))
2914 ;; Sorting is for debugging/testing
2915 (setq var-vals (sort var-vals
2917 (string< (symbol-name (car a))
2918 (symbol-name (car b))))))
2921 (defvar mumamo-major-modes-local-maps nil
2922 "An alist with major mode and local map.
2923 An entry in the list looks like
2925 \(MAJOR-MODE LOCAL-KEYMAP)")
2927 ;; (defun mumamo-font-lock-keyword-hook-symbol (major)
2928 ;; "Return hook symbol for adding font-lock keywords to MAJOR."
2929 ;; (intern (concat "mumamo-" (symbol-name major) "-font-lock-keyword-hook")))
2931 ;; (defun mumamo-remove-font-lock-hook (major setup-fun)
2932 ;; "For mode MAJOR remove function SETUP-FUN.
2933 ;; See `mumamo-add-font-lock-hook' for more information."
2934 ;; (remove-hook (mumamo-font-lock-keyword-hook-symbol major) setup-fun))
2936 (defun mumamo-refresh-multi-font-lock (major)
2937 "Refresh font lock information for mode MAJOR in chunks.
2938 If multi fontification functions for major mode MAJOR is already
2939 setup up they will be refreshed.
2941 If MAJOR is nil then all font lock information for major modes
2942 used in chunks will be refreshed.
2944 After calling font-lock-add-keywords or changing the
2945 fontification in other ways you must call this function for the
2946 changes to take effect. However already fontified buffers will
2947 not be refontified. You can use `normal-mode' to refontify
2950 Fix-me: Does not work yet."
2952 (setq mumamo-internal-major-modes-alist
2955 (assq-delete-all major mumamo-internal-major-modes-alist))))
2957 ;; RMS had the following idea:
2959 ;; Suppose we add a Lisp primitive to bind a set of variables under
2960 ;; the control of an alist. Would it be possible to eliminate these
2961 ;; helper functions and use that primitive instead?
2963 ;;; But wouldn't it be better to test this version first? There is
2964 ;;; no hurry, this version works and someone might find that there
2965 ;;; is a better way to do this than with helper functions.
2967 ;; OK with me, as long as this point doesn't get forgotten.
2968 (defun mumamo-fetch-major-mode-setup (major keywords mode-keywords add-keywords how)
2969 "Return a helper function to do fontification etc like in major mode MAJOR.
2970 Fetch the variables affecting font locking, indentation and
2971 filling by calling the major mode MAJOR in a temporary buffer.
2973 Make a function with one parameter BODY which is elisp code to
2974 eval. The function should let bind the variables above, sets the
2975 syntax table temporarily to the one used by the major mode
2976 \(using the mode symbol name to find it) and then evaluates body.
2978 Name this function mumamo-eval-in-MAJOR. Put the code for this
2979 function in the property `mumamo-defun' on this function symbol.
2982 ** Some notes about background etc.
2984 The function made here is used in `mumamo-with-major-mode-setup'.
2985 The code in the function parameter BODY is typically involved in
2986 fontification, indentation or filling.
2988 The main reasons for doing it this way is:
2990 - It is faster and than setting the major mode directly.
2991 - It does not affect buffer local variables."
2992 ;; (info "(elisp) Other Font Lock Variables")
2993 ;; (info "(elisp) Syntactic Font Lock)
2994 ;;(msgtrc "fetch-major 1: font-lock-keywords-only =%s" font-lock-keywords-only)
2995 (let ((func-sym (intern (concat "mumamo-eval-in-" (symbol-name major))))
2996 (func-def-sym (intern (concat "mumamo-def-eval-in-" (symbol-name major))))
2997 ;;(add-keywords-hook (mumamo-font-lock-keyword-hook-symbol major))
2999 (fetch-func-definition `(lambda (body))) ;;`(defun ,func-sym (body)))
3002 ;; font-lock-mode can't be turned on in buffers whose names start
3003 ;; with a char with white space syntax. Temp buffer names are
3004 ;; such and it is not possible to change name of a temp buffer.
3005 (setq temp-buf-name (concat "mumamo-fetch-major-mode-setup-" (symbol-name major)))
3006 (setq temp-buf (get-buffer temp-buf-name))
3007 (when temp-buf (kill-buffer temp-buf))
3008 (setq temp-buf (get-buffer-create temp-buf-name))
3009 ;;(msgtrc "fetch-major-mode-setup in buffer %s, after-chunk=%s, before with-current-buffer" (current-buffer) (when (boundp 'after-chunk) after-chunk))
3010 (with-current-buffer temp-buf
3012 (mumamo-msgfntfy "mumamo-fetch-major-mode-setup %s" major)
3013 (let ((mumamo-fetching-major t)
3014 mumamo-multi-major-mode)
3015 ;;(msgtrc "fetch-major-mode-setup in buffer %s, before (funcall %s)" (current-buffer) major)
3019 (mumamo-msgfntfy ">>> mumamo-fetch-major-mode-setup A font-lock-mode=%s" font-lock-mode)
3021 (mumamo-msgfntfy "<<< mumamo-fetch-major-mode-setup B font-lock-mode=%s" font-lock-mode)
3022 (mumamo-msgfntfy "mumamo-fetch-major-mode-setup: fetching jit-lock-after-change-extend-region-functions A=%s" jit-lock-after-change-extend-region-functions)
3024 ;; Note: font-lock-set-defaults must be called before adding
3025 ;; keywords. Otherwise Emacs loops. I have no idea why. Hm,
3026 ;; probably wrong, it is likely to be nxhtml-mumamo that is the
3027 ;; problem. Does not loop in html-mumamo.
3028 ;;(msgtrc "\n--------------------")
3029 (font-lock-set-defaults)
3030 ;; Fix-me: but hi-lock still does not work... what have I
3031 ;; forgotten??? font-lock-keywords looks ok...
3035 ;;(msgtrc "fetch:font-lock-add-keywords %S %S %S" (if mode-keywords major nil) keywords how)
3036 (font-lock-add-keywords (if mode-keywords major nil) keywords how)
3037 ;;(font-lock-add-keywords major keywords how)
3038 ;;(msgtrc "fetch:font-lock-keywords=%S" font-lock-keywords)
3040 (font-lock-remove-keywords (if mode-keywords major nil) keywords)
3041 ;;(font-lock-remove-keywords major keywords)
3043 (unless mode-keywords (font-lock-mode -1) (font-lock-mode 1))
3044 ;;(msgtrc "fetch-major-mode-setup:font-lock-keywords=%S" font-lock-keywords)
3046 ;;(run-hooks add-keywords-hook)
3048 (add-to-list 'mumamo-major-modes-local-maps
3049 (let ((local-map (current-local-map)))
3050 (cons major-mode (if local-map
3051 (copy-keymap local-map)
3054 (mumamo-msgfntfy "mumamo-fetch-major-mode-setup: fetching jit-lock-after-change-extend-region-functions B=%s" jit-lock-after-change-extend-region-functions)
3055 (let* ((syntax-sym (intern-soft (concat (symbol-name major) "-syntax-table")))
3056 (fetch-func-definition-let
3057 ;; Be XML compliant:
3059 (list 'sgml-xml-mode
3060 ;;(when (mumamo-derived-from-mode ',major 'sgml-mode) t))
3061 (when (mumamo-derived-from-mode major 'sgml-mode) t))
3063 ;; We need to copy the variables that we need and
3064 ;; that are not automatically buffer local, but
3065 ;; could be it. Arguably it is a bug if they are not
3066 ;; buffer local though we have to adapt.
3069 (list 'indent-line-function (custom-quote indent-line-function))
3070 (list 'indent-region-function (custom-quote indent-region-function))
3071 (list 'normal-auto-fill-function (custom-quote normal-auto-fill-function))
3072 (list 'comment-start (custom-quote comment-start))
3073 (list 'comment-end (custom-quote comment-end))
3074 (list 'comment-start-skip (custom-quote comment-start-skip))
3075 (list 'comment-end-skip (custom-quote comment-end-skip))
3076 (list 'comment-multi-line (custom-quote comment-multi-line))
3077 (list 'comment-line-break-function (custom-quote comment-line-break-function))
3078 (list 'paragraph-start (custom-quote paragraph-start))
3079 (list 'paragraph-separate (custom-quote paragraph-separate))
3080 (list 'paragraph-ignore-fill-prefix (custom-quote paragraph-ignore-fill-prefix))
3081 (list 'adaptive-fill-mode (custom-quote adaptive-fill-mode))
3082 (list 'adaptive-fill-regexp (custom-quote adaptive-fill-regexp))
3084 ;;; Try doing the font lock things last, keywords really last
3085 (list 'font-lock-multiline (custom-quote font-lock-multiline))
3086 (list 'font-lock-extend-after-change-region-function (custom-quote font-lock-extend-after-change-region-function))
3087 (list 'font-lock-extend-region-functions (custom-quote font-lock-extend-region-functions))
3088 (list 'font-lock-comment-start-skip (custom-quote font-lock-comment-start-skip))
3089 (list 'font-lock-comment-end-skip (custom-quote font-lock-comment-end-skip))
3090 (list 'font-lock-syntactic-keywords (custom-quote font-lock-syntactic-keywords))
3092 (list 'font-lock-keywords (custom-quote font-lock-keywords))
3093 ;;(list 'font-lock-keywords-alist (custom-quote font-lock-keywords-alist))
3094 ;;(list 'font-lock-removed-keywords-alist (custom-quote font-lock-removed-keywords-alist))
3096 ;; Fix-me: uncommenting this line (as it should be)
3097 ;; sets font-lock-keywords-only to t globally...: bug 3467
3098 (list 'font-lock-keywords-only (custom-quote font-lock-keywords-only))
3100 (list 'font-lock-keywords-case-fold-search (custom-quote font-lock-keywords-case-fold-search))
3102 (list 'font-lock-set-defaults t) ; whether we have set up defaults.
3104 ;; Set from font-lock-defaults normally:
3105 (list 'font-lock-defaults (custom-quote (copy-tree font-lock-defaults)))
3106 ;; Syntactic Font Lock
3107 (list 'font-lock-syntax-table (custom-quote font-lock-syntax-table)) ;; See nXhtml bug 400415
3108 (list 'font-lock-beginning-of-syntax-function (custom-quote font-lock-beginning-of-syntax-function))
3109 (list 'font-lock-syntactic-face-function (custom-quote font-lock-syntactic-face-function))
3111 ;; Other Font Lock Variables
3112 (list 'font-lock-mark-block-function (custom-quote font-lock-mark-block-function))
3113 (list 'font-lock-extra-managed-props (custom-quote font-lock-extra-managed-props))
3114 ;; This value is fetched from font-lock:
3115 (list 'font-lock-fontify-buffer-function (custom-quote font-lock-fontify-buffer-function))
3116 (list 'font-lock-unfontify-buffer-function (custom-quote font-lock-unfontify-buffer-function))
3117 (list 'font-lock-fontify-region-function (custom-quote font-lock-fontify-region-function))
3118 (list 'font-lock-unfontify-region-function (custom-quote font-lock-unfontify-region-function))
3120 ;; Jit Lock Variables
3121 (list 'jit-lock-after-change-extend-region-functions (custom-quote jit-lock-after-change-extend-region-functions))
3123 ;;(list 'syntax-table (custom-quote (copy-syntax-table (syntax-table))))
3124 ;;(list 'mumamo-original-syntax-begin-function (custom-quote syntax-begin-function))
3125 (list 'syntax-begin-function (custom-quote syntax-begin-function))
3126 (list 'fill-paragraph-function (custom-quote fill-paragraph-function))
3127 (list 'fill-forward-paragraph-function
3128 (when (boundp 'fill-forward-paragraph-function)
3129 (custom-quote fill-forward-paragraph-function)))
3132 (list 'comment-use-global-state (custom-quote (when (boundp 'comment-use-global-state) comment-use-global-state)))
3135 (list 'multibyte-syntax-as-symbol (custom-quote multibyte-syntax-as-symbol))
3136 (list 'parse-sexp-ignore-comments (custom-quote parse-sexp-ignore-comments))
3137 (list 'parse-sexp-lookup-properties (custom-quote parse-sexp-lookup-properties))
3138 ;; fix-me: does not the next line work?
3139 (list 'forward-sexp-function (custom-quote forward-sexp-function))
3141 (relevant-buffer-locals (mumamo-get-relevant-buffer-local-vars))
3143 ;;(append '(1 2) '(3 4) '((eval body)))
3144 (mumamo-msgfntfy "===========> before setq fetch-func-definition %s" func-sym)
3146 (dolist (fetched fetch-func-definition-let)
3147 (let ((fvar (car fetched)))
3148 (setq relevant-buffer-locals (assq-delete-all fvar relevant-buffer-locals))))
3149 (setq fetch-func-definition
3150 (append fetch-func-definition
3151 `((let ,(append fetch-func-definition-let
3152 relevant-buffer-locals)
3153 (with-syntax-table ,(if syntax-sym
3155 '(standard-syntax-table));;'syntax-table
3156 ;; fix-me: Protect against font-lock-keywords-only to t globally...: bug 3467
3157 ;;(msgtrc "%s enter 1: font-lock-keywords-only def=%s, body=%S" ',major (default-value 'font-lock-keywords-only) body)
3158 (let (;(font-lock-keywords-only font-lock-keywords-only)
3160 ;;(msgtrc "%s enter 2: font-lock-keywords-only def=%s" ',major (default-value 'font-lock-keywords-only))
3161 (setq ret (eval body))
3162 ;;(msgtrc "%s exit 1: font-lock-keywords-only def=%s" ',major (default-value 'font-lock-keywords-only))
3164 ;;(msgtrc "in %s 1: font-lock-keywords-only =%s in buffer %s, def=%s" ',func-sym font-lock-keywords-only (current-buffer) (default-value 'font-lock-keywords-only))
3166 ;;(msgtrc "in %s 2: font-lock-keywords-only =%s in buffer %s, def=%s" ',func-sym font-lock-keywords-only (current-buffer) (default-value 'font-lock-keywords-only))
3167 ;;(message "backtrace there:\n%s" (with-output-to-string (backtrace)))
3170 (setq byte-compiled-fun (let ((major-syntax-table))
3171 (byte-compile fetch-func-definition)))
3172 (assert (functionp byte-compiled-fun))
3174 (eval `(defvar ,func-sym nil))
3175 (eval `(defvar ,func-def-sym ,fetch-func-definition))
3176 (set func-sym byte-compiled-fun) ;; Will be used as default
3177 (assert (functionp (symbol-value func-sym)) t)
3178 (funcall (symbol-value func-sym) nil)
3179 (put func-sym 'permanent-local t)
3180 (put func-def-sym 'permanent-local t))))
3181 (kill-buffer temp-buf)
3182 ;; Use the new value in current buffer.
3184 ;;(set (make-local-variable func-sym) (symbol-value func-sym))
3185 ;;(msgtrc "fetch: major=%s func-def-sym=%s cb=%s fetch-func-definition=%s" major func-def-sym (current-buffer) fetch-func-definition)
3186 ;;(msgtrc "fetch: major=%s func-def-sym=%s cb=%s fetch-func-definition" major func-def-sym (current-buffer))
3187 (set (make-local-variable func-sym) byte-compiled-fun)
3188 (set (make-local-variable func-def-sym) fetch-func-definition)
3189 (put func-sym 'permanent-local t)
3190 (put func-def-sym 'permanent-local t))
3191 (assert (functionp (symbol-value func-sym)) t)
3192 ;; return a list def + fun
3193 (cons func-sym func-def-sym)))
3195 ;; Fix-me: maybe a hook in font-lock-add-keywords??
3196 (defun mumamo-ad-font-lock-keywords-helper (major keywords how add-keywords)
3197 ;;(msgtrc "ad-font-lock-keywords-helper %s %s %s %s" major keywords how add-keywords)
3199 (mumamo-fetch-major-mode-setup major keywords t t how)
3200 ;; Fix-me: Can't do that, need a list of all
3201 ;; mumamo-current-chunk-family chunk functions major
3202 ;; modes. But this is impossible since the major modes might
3203 ;; be determined dynamically. As a work around look in current
3205 (let ((majors (list (mumamo-main-major-mode))))
3206 (dolist (entry mumamo-internal-major-modes-alist)
3207 (let ((major (car entry))
3208 (fun-var-sym (caadr entry)))
3209 (when (local-variable-p fun-var-sym)
3210 (setq majors (cons (car entry) majors)))))
3211 (dolist (major majors)
3212 (setq major (mumamo-get-major-mode-substitute major 'fontification))
3213 ;;(msgtrc "(fetch-major-mode-setup %s %s %s %s %s)" major keywords nil t how)
3214 (mumamo-fetch-major-mode-setup major keywords nil add-keywords how))
3215 ;;(font-lock-mode -1) (font-lock-mode 1)
3218 ;; Fix-me: This has stopped working again 2009-11-04, but I do not know when it began...
3219 (defadvice font-lock-add-keywords (around
3220 mumamo-ad-font-lock-add-keywords
3223 (if (or (boundp 'mumamo-fetching-major) (boundp 'mumamo-add-font-lock-called) (not mumamo-multi-major-mode))
3225 (let (mumamo-multi-major-mode
3226 mumamo-add-font-lock-called
3227 (major (ad-get-arg 0))
3228 (keywords (ad-get-arg 1))
3229 (how (ad-get-arg 2)))
3230 (mumamo-ad-font-lock-keywords-helper major keywords how t))))
3232 (defadvice font-lock-remove-keywords (around
3233 mumamo-ad-font-lock-remove-keywords
3236 (if (or (boundp 'mumamo-fetching-major) (boundp 'mumamo-add-font-lock-called) (not mumamo-multi-major-mode))
3238 (let (mumamo-multi-major-mode
3239 mumamo-add-font-lock-called
3240 (major (ad-get-arg 0))
3241 (keywords (ad-get-arg 1)))
3242 (mumamo-ad-font-lock-keywords-helper major keywords nil nil))))
3244 (defun mumamo-bad-mode ()
3245 "MuMaMo replacement for a major mode that could not be loaded."
3247 (kill-all-local-variables)
3248 (setq major-mode 'mumamo-bad-mode)
3250 (propertize "Mumamo Bad Mode"
3251 'face 'font-lock-warning-face)))
3253 ;;(mumamo-get-major-mode-setup 'css-mode)
3254 ;;(mumamo-get-major-mode-setup 'fundamental-mode)
3255 (defun mumamo-get-major-mode-setup (use-major)
3256 "Return function for evaluating code in major mode USE-MAJOR.
3257 Fix-me: This doc string is wrong, old:
3259 Get local variable values for major mode USE-MAJOR. These
3260 variables are used for indentation and fontification. The
3261 variables are returned in a list with the same format as
3262 `mumamo-fetch-major-mode-setup'.
3264 The list of local variable values which is returned by this
3265 function is cached in `mumamo-internal-major-modes-alist'. This
3266 avoids calling the major mode USE-MAJOR for each chunk during
3267 fontification and speeds up fontification significantly."
3268 ;; Fix-me: Problems here can cause mumamo to loop badly when this
3269 ;; function is called over and over again. To avoid this add a
3270 ;; temporary entry using mumamo-bad-mode while trying to fetch the
3273 ;;(assq 'mumamo-bad-mode mumamo-internal-major-modes-alist)
3274 (let ((use-major-entry (assq use-major mumamo-internal-major-modes-alist))
3279 (unless use-major-entry
3280 ;; Get mumamo-bad-mode entry and add a dummy entry based on
3281 ;; this to avoid looping.
3282 (setq bad-mode-entry
3283 (assq 'mumamo-bad-mode mumamo-internal-major-modes-alist))
3284 (unless bad-mode-entry
3285 ;; Assume it is safe to get the mumamo-bad-mode entry ;-)
3286 (add-to-list 'mumamo-internal-major-modes-alist
3287 (list 'mumamo-bad-mode
3288 (mumamo-fetch-major-mode-setup 'mumamo-bad-mode nil nil nil nil)))
3289 (setq bad-mode-entry
3290 (assq 'mumamo-bad-mode mumamo-internal-major-modes-alist)))
3291 (setq dummy-entry (list use-major (cadr bad-mode-entry)))
3292 ;; Before fetching setup add the dummy entry and then
3293 ;; immediately remove it.
3294 (add-to-list 'mumamo-internal-major-modes-alist dummy-entry)
3295 (setq use-major-entry (list use-major
3296 (mumamo-fetch-major-mode-setup use-major nil nil nil nil)))
3297 (setq mumamo-internal-major-modes-alist
3299 mumamo-internal-major-modes-alist))
3300 (add-to-list 'mumamo-internal-major-modes-alist use-major-entry))
3301 (setq fun-var-sym (caadr use-major-entry))
3302 (setq fun-var-def-sym (cdadr use-major-entry))
3303 (assert (functionp (symbol-value fun-var-sym)) t)
3304 (assert (eq 'lambda (car (symbol-value fun-var-def-sym))) t)
3305 ;; Always make a buffer local value for keywords.
3306 (unless (local-variable-p fun-var-sym)
3307 (set (make-local-variable fun-var-sym) (symbol-value fun-var-sym))
3308 (set (make-local-variable fun-var-def-sym) (symbol-value fun-var-def-sym)))
3309 (caadr (or (assq use-major mumamo-internal-major-modes-alist)
3312 ;; (add-to-list 'mumamo-internal-major-modes-alist
3314 ;; (mumamo-fetch-major-mode-setup
3315 ;; use-major nil nil nil))))))))
3317 (defun mumamo-remove-all-chunk-overlays ()
3318 "Remove all CHUNK overlays from the current buffer."
3321 (mumamo-delete-new-chunks)))
3327 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3328 ;;;; Creating and accessing chunks
3330 (defun mumamo-define-no-mode (mode-sym)
3331 "Fallback major mode when no major mode for MODE-SYM is found."
3332 (let ((mumamo-repl4 (intern (format "mumamo-4-%s" mode-sym)))
3333 (lighter (format "No %s" mode-sym))
3334 (doc (format "MuMaMo replacement for %s which was not found."
3336 (if (commandp mumamo-repl4)
3338 (eval `(defun ,mumamo-repl4 ()
3341 (kill-all-local-variables)
3342 (setq major-mode ',mumamo-repl4)
3344 (propertize ,lighter
3345 'face 'font-lock-warning-face)))))))
3346 ;;(mumamo-define-no-mode 'my-ownB-mode)
3348 ;;(mumamo-major-mode-from-modespec 'javascript-mode)
3349 (defun mumamo-major-mode-from-modespec (major-spec)
3350 "Translate MAJOR-SPEC to a major mode.
3351 Translate MAJOR-SPEC used in chunk definitions of multi major
3352 modes to a major mode.
3354 See `mumamo-major-modes' for an explanation."
3355 (mumamo-major-mode-from-spec major-spec mumamo-major-modes))
3357 (defun mumamo-major-mode-from-spec (major-spec table)
3359 (mumamo-backtrace "mode-from-modespec, major-spec is nil"))
3360 (let ((modes (cdr (assq major-spec table)))
3361 (mode 'mumamo-bad-mode))
3366 (let ((def (symbol-function m)))
3367 (when (and (listp def)
3368 (eq 'autoload (car def)))
3369 (mumamo-condition-case err
3371 (error (setq m nil)))))
3372 (when m (throw 'mode m))))
3375 (if (functionp major-spec)
3376 ;; As a last resort allow spec to be a major mode too:
3377 (setq mode major-spec)
3379 (mumamo-warn-once '(mumamo-major-mode-from-modespec)
3380 "Couldn't find an available major mode for specification %s,\n alternatives are:\n %s"
3382 (mumamo-warn-once '(mumamo-major-mode-from-modespec)
3383 "Couldn't find an available major mode for spec %s"
3385 ;;(setq mode 'fundamental-mode)
3386 (setq mode (mumamo-define-no-mode major-spec))
3388 (mumamo-msgfntfy " mumamo-major-mode-from-modespec %s => %s" major-spec mode)
3391 (defun mumamo-get-existing-new-chunk-at (pos &optional first)
3392 "Return last existing chunk at POS if any.
3393 However if FIRST get first existing chunk at POS instead."
3394 ;;(msgtrc "(mumamo-get-existing-new-chunk-at %s)" pos)
3397 (when (= pos (point-max))
3398 (setq pos (1- pos)))
3399 (when (= pos 0) (setq pos 1))
3400 (dolist (o (overlays-in pos (1+ pos)))
3401 (when (and (overlay-get o 'mumamo-is-new)
3402 ;; Because overlays-in need to have a range of length
3403 ;; > 0 we might have got overlays that is after our
3405 (<= (overlay-start o) orig-pos))
3406 ;; There can be two, choose the last or first depending on
3409 ;; (when (or (> (overlay-end o) (overlay-start o))
3410 ;; (overlay-get o 'mumamo-prev-chunk))
3412 (< (overlay-end o) (overlay-end chunk-ovl))
3413 (> (overlay-end o) (overlay-end chunk-ovl))
3416 (setq chunk-ovl o))))
3419 (defun mumamo-get-chunk-save-buffer-state (pos)
3420 "Return chunk overlay at POS. Preserve state."
3422 ;;(mumamo-save-buffer-state nil
3423 ;;(setq chunk (mumamo-get-chunk-at pos)))
3424 (setq chunk (mumamo-find-chunks pos "mumamo-get-chunk-save-buffer-state"))
3430 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3431 ;;;; Chunk and chunk family properties
3433 (defun mumamo-syntax-maybe-completable (pnt)
3434 "Return non-nil if at point PNT non-printable characters may occur.
3435 This just considers existing chunks."
3436 (let* ((chunk (mumamo-find-chunks pnt "mumamo-syntax-maybe-completable"))
3440 (mumamo-update-obscure chunk pnt)
3441 (setq syn-min-max (mumamo-chunk-syntax-min-max chunk nil))
3442 ;;(and (> pnt (1+ (mumamo-chunk-syntax-min chunk)))
3443 (and (> pnt (1+ (car syn-min-max)))
3444 ;;(< pnt (1- (mumamo-chunk-syntax-max chunk)))))))
3445 (< pnt (1- (cdr syn-min-max)))))))
3447 (defvar mumamo-current-chunk-family nil
3448 "The currently used chunk family.")
3449 (make-variable-buffer-local 'mumamo-current-chunk-family)
3450 (put 'mumamo-current-chunk-family 'permanent-local t)
3452 ;; (defvar mumamo-main-major-mode nil)
3453 ;; (make-variable-buffer-local 'mumamo-main-major-mode)
3454 ;; (put 'mumamo-main-major-mode 'permanent-local t)
3456 (defun mumamo-main-major-mode ()
3457 "Return major mode used when there are no chunks."
3458 (let ((mm (cadr mumamo-current-chunk-family)))
3460 (msgtrc "main-major-mode => nil, mumamo-current-chunk-family=%s" mumamo-current-chunk-family))))
3461 ;;; (let ((main (cadr mumamo-current-chunk-family)))
3464 ;;; mumamo-main-major-mode)))
3466 ;; (defun mumamo-unset-chunk-family ()
3467 ;; "Set chunk family to nil, ie undecided."
3469 ;; (setq mumamo-current-chunk-family nil))
3471 ;; (defun mumamo-define-chunks (chunk-family)
3472 ;; "Set the CHUNK-FAMILY used to divide the buffer."
3473 ;; (setq mumamo-current-chunk-family chunk-family))
3476 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3477 ;;;; General chunk search routines
3479 ;; search start forward
3481 ;;(defun mumamo-search-fw-exc-start-str (pos max marker)
3482 (defun mumamo-chunk-start-fw-str (pos max marker)
3483 "General chunk function helper.
3484 A chunk function helper like this can be used in
3485 `mumamo-find-possible-chunk' to find the borders of a chunk.
3486 There are several functions like this that comes with mumamo.
3487 Their names tell what they do. Lets look at the parts of the
3488 name of this function:
3490 mumamo-chunk: All this helper functions begins so
3491 -start-: Search for the start of a chunk
3492 -fw-: Search forward
3493 -str: Search for a string
3495 Instead of '-start-' there could be '-end-', ie end.
3496 Instead of '-fw-' there could be '-bw-', ie backward.
3497 Instead of '-str' there could be '-re', ie regular expression.
3499 There could also be a '-inc' at the end of the name. If the name
3500 ends with this then the markers should be included in the chunks,
3503 The argument POS means where to start the search. MAX means how
3504 far to search (when searching backwards the argument is called
3505 'min' instead). MARKER is a string or regular expression (see
3506 the name) to search for."
3507 (assert (stringp marker))
3508 (let ((pm (point-min))
3509 (cb (current-buffer)))
3510 (message "cb=%s" cb)
3511 (goto-char (max pm (- pos (length marker)))))
3512 (search-forward marker max t))
3514 (defun mumamo-chunk-start-fw-re (pos max marker)
3515 "General chunk function helper.
3516 See `mumamo-chunk-start-fw-str' for more information and the
3517 meaning of POS, MAX and MARKER."
3518 (assert (stringp marker))
3519 (goto-char (- pos (length marker)))
3520 (re-search-forward marker max t))
3522 (defun mumamo-chunk-start-fw-str-inc (pos max marker)
3523 "General chunk function helper.
3524 See `mumamo-chunk-start-fw-str' for more information and the
3525 meaning of POS, MAX and MARKER."
3526 (assert (stringp marker))
3528 (let ((start (search-forward marker max t)))
3529 (when start (setq start (- start (length marker))))))
3531 ;; search start backward
3533 ;; (defun mumamo-chunk-start-bw-str (pos min marker)
3534 ;; "General chunk function helper.
3535 ;; See `mumamo-chunk-start-fw-str' for more information and the
3536 ;; meaning of POS, MIN and MARKER."
3537 ;; ;;(assert (stringp marker))
3540 ;; (setq start-in (search-backward marker min t))
3542 ;; ;; do not include the marker
3543 ;; (setq start-in (+ start-in (length marker))))
3546 ;; (defun mumamo-chunk-start-bw-re (pos min marker)
3547 ;; "General chunk function helper.
3548 ;; See `mumamo-chunk-start-fw-str' for more information and the
3549 ;; meaning of POS, MIN and MARKER."
3550 ;; (assert (stringp marker))
3553 ;; (setq start-in (re-search-backward marker min t))
3555 ;; ;; do not include the marker
3556 ;; (setq start-in (match-end 0)))
3559 ;; (defun mumamo-chunk-start-bw-str-inc (pos min marker)
3560 ;; "General chunk function helper.
3561 ;; See `mumamo-chunk-start-fw-str' for more information and the
3562 ;; meaning of POS, MIN and MARKER."
3563 ;; (assert (stringp marker))
3564 ;; (goto-char (+ pos (length marker)))
3565 ;; (search-backward marker min t))
3567 ;; search end forward
3569 (defun mumamo-chunk-end-fw-str (pos max marker)
3570 "General chunk function helper.
3571 See `mumamo-chunk-start-fw-str' for more information and the
3572 meaning of POS, MAX and MARKER."
3573 (assert (stringp marker))
3574 ;;(goto-char (1+ pos)) ;; 1+ cause otherwise ?> is at point
3577 (setq end-in (search-forward marker max t))
3579 ;; do not include the marker
3580 (setq end-in (- end-in (length marker))))
3583 (defun mumamo-chunk-end-fw-re (pos max marker)
3584 "General chunk function helper.
3585 See `mumamo-chunk-start-fw-str' for more information and the
3586 meaning of POS, MAX and MARKER."
3587 (assert (stringp marker))
3588 (goto-char (1+ pos)) ;; 1+ cause otherwise ?> is at point
3590 (setq end-in (re-search-forward marker max t))
3592 ;; do not include the marker
3593 (setq end-in (match-beginning 0)))
3596 (defun mumamo-chunk-end-fw-str-inc (pos max marker)
3597 "General chunk function helper.
3598 See `mumamo-chunk-start-fw-str' for more information and the
3599 meaning of POS, MAX and MARKER."
3600 (assert (stringp marker))
3601 ;;(goto-char (1+ pos)) ;; 1+ cause otherwise ?> is at point
3602 (goto-char (1+ (- pos (length marker))))
3603 ;;(msgtrc "mumamo-chunk-end-fw-str-inc %s %s %s, point=%s point-max=%s" pos max marker (point) (point-max))
3604 (search-forward marker max t))
3606 ;; search end backward
3608 ;; (defun mumamo-chunk-end-bw-str (pos min marker)
3609 ;; "General chunk function helper.
3610 ;; See `mumamo-chunk-start-fw-str' for more information and the
3611 ;; meaning of POS, MIN and MARKER."
3612 ;; (assert (stringp marker))
3613 ;; (goto-char (+ pos (length marker)))
3614 ;; (search-backward marker min t))
3616 ;; (defun mumamo-chunk-end-bw-re (pos min marker)
3617 ;; "General chunk function helper.
3618 ;; See `mumamo-chunk-start-fw-str' for more information and the
3619 ;; meaning of POS, MIN and MARKER."
3620 ;; (assert (stringp marker))
3621 ;; (goto-char (+ pos (length marker)))
3622 ;; (re-search-backward marker min t))
3624 (defun mumamo-chunk-end-bw-str-inc (pos min marker)
3625 "General chunk function helper.
3626 See `mumamo-chunk-start-fw-str' for more information and the
3627 meaning of POS, MIN and MARKER."
3628 (assert (stringp marker))
3630 (let ((end (search-backward marker min t)))
3631 (when end (setq end (+ end (length marker))))))
3634 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3635 ;;;; General chunk routines
3637 ;; (defvar mumamo-known-chunk-start nil "Internal use only!.")
3639 (defconst mumamo-string-syntax-table
3640 (let ((tbl (copy-syntax-table)))
3641 (modify-syntax-entry ?\" "\"" tbl)
3642 (modify-syntax-entry ?\' "\"" tbl)
3644 "Just for \"..\" and '...'.")
3646 ;; "..." '...' "..'.." '.."..'
3647 (defun mumamo-guess-in-string (pos)
3648 "If POS is in a string then return string start position.
3649 Otherwise return nil."
3650 (when (and (>= pos (point-min)))
3651 (let ((here (point))
3652 (inhibit-field-text-motion t)
3658 (setq line-beg (line-beginning-position))
3659 (setq parsed (with-syntax-table mumamo-string-syntax-table
3660 (parse-partial-sexp line-beg pos)))
3661 (setq str-char (nth 3 parsed))
3663 (skip-chars-backward (string ?^ str-char))
3664 (setq str-pos (point)))
3668 ;;; The main generic chunk routine
3670 ;; Fix-me: new routine that really search forward only. Rewrite
3671 ;; `mumamo-quick-static-chunk' first with this.
3672 (defun mumamo-possible-chunk-forward (pos
3676 &optional borders-fun)
3677 "Search forward from POS to MAX for possible chunk.
3678 Return as a list with values
3680 \(START END CHUNK-MAJOR BORDERS PARSEABLE-BY CHUNK-END-FUN BORDERS-FUN)
3682 START and END are start and end of the possible chunk.
3683 CHUNK-MAJOR is the major mode specifier for this chunk. \(Note
3684 that this specifier is translated to a major mode through
3685 `mumamo-major-modes'.)
3687 START-BORDER and END-BORDER may be nil. Otherwise they should be
3688 the position where the border ends respectively start at the
3689 corresponding end of the chunk.
3691 BORDERS is the return value of the optional BORDERS-FUN which
3692 takes three parameters, START, END and EXCEPTION-MODE in the
3693 return values above. BORDERS may be nil and otherwise has this
3696 \(START-BORDER END-BORDER CHUNK-MAJOR CHUNK-END-FUN)
3698 PARSEABLE-BY is a list of major modes with parsers that can parse
3701 CHUNK-START-FUN and CHUNK-END-FUN should be functions that
3702 searches forward from point for start and end of chunk. They
3703 both take two parameters, POS and MAX above. If no possible
3704 chunk is found both these functions should return nil, otherwise
3707 CHUNK-START-FUN should return a list of the form below if a
3708 possible chunk is found:
3710 (START CHUNK-MAJOR PARSEABLE-BY)
3712 CHUNK-END-FUN should return the end of the chunk.
3715 ;;(msgtrc "possible-chunk-forward %s %s" pos max)
3716 (let ((here (point))
3726 ;; Fix-me: check valid. Should this perhaps be done in the
3727 ;; function calling this instead?
3728 ;;(mumamo-end-in-code syntax-min syntax-max curr-major)
3729 (setq start-rec (funcall chunk-start-fun (point) max))
3731 (setq start (nth 0 start-rec))
3732 (setq chunk-major (nth 1 start-rec))
3733 (setq parseable-by (nth 2 start-rec))
3735 ;; Fix-me: check valid
3736 ;;(setq end (funcall chunk-end-fun (point) max))
3738 (let ((start-border (when start (unless (and (= 1 start)
3741 (end-border (when end (unless (and (= (point-max) end)
3744 (setq borders (funcall borders-fun start-border end-border chunk-major))))
3745 (setq ret (list start end chunk-major borders parseable-by chunk-end-fun borders-fun)))
3749 ;; Fix-me: This routine has some difficulties. One of the more
3750 ;; problematic things is that chunk borders may depend on the
3751 ;; surrounding chunks syntax. Patterns that possibly could be chunk
3752 ;; borders might instead be parts of comments or strings in cases
3753 ;; where they should not be valid borders there.
3754 (defun mumamo-find-possible-chunk (pos
3756 bw-exc-start-fun ;; obsolete
3760 &optional find-borders-fun)
3761 (mumamo-find-possible-chunk-new pos
3770 (defun mumamo-find-possible-chunk-new (pos
3777 &optional find-borders-fun)
3778 ;; This should return no end value!
3779 "Return list describing a possible chunk that starts after POS.
3780 No notice is taken about existing chunks and no chunks are
3781 created. The description returned is for the smallest possible
3782 chunk which is delimited by the function parameters.
3784 POS must be less than MAX.
3786 The function BW-EXC-START-FUN takes two parameters, POS and
3787 MIN. It should search backward from POS, bound by MIN, for
3788 exception start and return a cons or a list:
3790 \(FOUND-POS . EXCEPTION-MODE)
3791 \(FOUND-POS EXCEPTION-MODE PARSEABLE-BY)
3793 Here FOUND-POS is the start of the chunk. EXCEPTION-MODE is the
3794 major mode specifier for this chunk. \(Note that this specifier
3795 is translated to a major mode through `mumamo-major-modes'.)
3797 PARSEABLE-BY is a list of parsers that can handle the chunk
3798 beside the one that may be used by the chunks major mode.
3799 Currently only the XML parser in `nxml-mode' is recognized. In
3800 this list it should be the symbol `nxml-mode'.
3802 The functions FW-EXC-START-FUN and FW-EXC-END-FUN should search
3803 for exception start or end, forward resp backward. Those two
3804 takes two parameters, start position POS and max position MAX,
3805 and should return just the start respectively the end of the
3808 For all three functions the position returned should be nil if
3812 Return as a list with values
3814 \(START END EXCEPTION-MODE BORDERS PARSEABLE-BY FR-EXC-FUN FIND-BORDERS-FUN)
3816 **Fix-me: FIND-BORDERS-FUN must be split for chunks-in-chunks!
3818 The bounds START and END are where the exception starts or stop.
3819 Either of them may be nil, in which case this is equivalent to
3820 `point-min' respectively `point-max'.
3822 If EXCEPTION-MODE is non-nil that is the submode for this
3823 range. Otherwise the main major mode should be used for this
3826 BORDERS is the return value of the optional FIND-BORDERS-FUN
3827 which takes three parameters, START, END and EXCEPTION-MODE in
3828 the return values above. BORDERS may be nil and otherwise has
3831 \(START-BORDER END-BORDER EXCEPTION-MODE FW-EXC-FUN)
3833 START-BORDER and END-BORDER may be nil. Otherwise they should be
3834 the position where the border ends respectively start at the
3835 corresponding end of the chunk.
3837 PARSEABLE-BY is a list of major modes with parsers that can parse
3840 FW-EXC-FUN is the function that finds the end of the chunk. This
3841 is either FW-EXC-START-FUN or FW-EXC-END-FUN.
3843 ---- * Note: This routine is used by to create new members for
3844 chunk families. If you want to add a new chunk family you could
3845 most often do that by writing functions for this routine. Please
3846 see the many examples in mumamo-fun.el for how this can be done.
3847 See also `mumamo-quick-static-chunk'."
3849 ;;(msgtrc "find-poss-new %s %s %s %s %s %s" pos max bw-exc-start-fun fw-exc-start-fun fw-exc-end-fun find-borders-fun)
3851 ;;(mumamo-condition-case err
3853 (assert (and (<= pos max)) nil
3854 "mumamo-chunk: pos=%s, max=%s, bt=%S"
3855 pos max (with-output-to-string (backtrace)))
3856 ;; "in" refers to "in exception" and "out" is then in main
3869 (main-major (mumamo-main-major-mode))
3873 ;;;; find start of range
3877 ;;(setq start-out (funcall bw-exc-end-fun pos min))
3878 ;; Do not check end here!
3879 ;;(setq start-out (funcall fw-exc-end-fun pos max))
3880 ;;(msgtrc "find-poss-new.start-out=%s" start-out)
3882 (setq start-in (funcall fw-exc-start-fun pos max))
3883 ;;(msgtrc "find-poss-new.start-in=%s" start-in)
3884 (when (listp start-in)
3885 (setq fw-exc-mode (nth 1 start-in))
3886 (setq start-in (car start-in)))
3888 (when (and start-in start-out)
3889 (if (> start-in start-out)
3891 (setq start-out nil)))
3894 (setq start-in-cons (funcall bw-exc-start-fun start-in pos))
3895 ;;(msgtrc "find-poss-new.start-in=%s start-in-cons=%s" start-in start-in-cons)
3897 (assert (= start-in (car start-in-cons)))
3898 (setq exc-mode (cdr start-in-cons)))
3899 (setq start start-in))
3901 (setq start start-out))
3905 (setq parseable-by (cadr exc-mode))
3906 (setq exc-mode (car exc-mode)))
3908 (when find-borders-fun
3909 (let ((start-border (when start (unless (and (= 1 start)
3912 (end-border (when end (unless (and (= (point-max) end)
3915 (setq borders (funcall find-borders-fun start-border end-border exc-mode))))
3917 (setq border-beg (nth 0 borders))
3918 (setq border-end (nth 1 borders))
3919 ;;(when start (assert (<= start pos)))
3920 ;;(assert (or (not start) (= start pos)))
3922 (assert (<= start border-beg)))
3923 ;; Fix-me: This is just totally wrong in some pieces and a
3924 ;; desperate try after seeing the problems with wp-app.php
3925 ;; around line 1120. Maybe this can be used when cutting chunks
3926 ;; from top to bottom however.
3928 (let ((here (point))
3932 (start-border (or (nth 0 borders) start))
3933 (end-border (or (nth 1 borders) end)))
3934 ;; Check if in string
3935 ;; Fix-me: add comments about why and examples + tests
3936 ;; Fix-me: must loop to find good borders ....
3938 ;; Fix-me: more careful positions for guess
3940 (mumamo-guess-in-string
3946 (setq start-in-string
3947 (mumamo-guess-in-string
3951 (if (not start-in-string)
3954 (if (and start-in-string end-in-string)
3955 ;; If both are in a string and on the same line then
3956 ;; guess this is actually borders, otherwise not.
3957 (unless (= start-in-string end-in-string)
3960 (when start-in-string (setq start nil))
3961 (when end-in-string (setq end nil)))
3963 (when start-in-string (setq start nil))
3965 (unless (or start end)
3968 (setq parseable-by nil))))))
3970 (when (or start end exc-mode borders parseable-by)
3971 (setq fw-exc-fun (if exc-mode
3972 ;; Fix-me: this is currently correct,
3973 ;; but will change if exc mode in exc
3976 ;; Fix-me: these should be collected later
3980 (mumamo-msgfntfy "--- mumamo-find-possible-chunk-new %s" (list start end exc-mode borders parseable-by fw-exc-fun))
3981 ;;(message "--- mumamo-find-possible-chunk-new %s" (list start end exc-mode borders parseable-by fw-exc-fun))
3983 (unless (eq fw-exc-mode exc-mode)
3984 ;;(message "fw-exc-mode=%s NEQ exc-mode=%s" fw-exc-mode exc-mode)
3986 ;;(msgtrc "find-poss-new returns %s" (list start end exc-mode borders parseable-by fw-exc-fun find-borders-fun))
3988 (list start end exc-mode borders parseable-by fw-exc-fun find-borders-fun)))))
3989 ;;(error (mumamo-display-error 'mumamo-chunk "%s" (error-message-string err)))
3994 ;; (defun temp-overlays-here ()
3996 ;; (let* ((here (point))
3997 ;; (ovl-at (overlays-at here))
3998 ;; (ovl-in (overlays-in here (1+ here)))
3999 ;; (ovl-in0 (overlays-in here here))
4001 ;; (with-output-to-temp-buffer (help-buffer)
4002 ;; (help-setup-xref (list #'temp-overlays-at) (interactive-p))
4003 ;; (with-current-buffer (help-buffer)
4004 ;; (insert (format "overlays-at %s:\n%S\n\n" here ovl-at))
4005 ;; (insert (format "overlays-in %s-%s:\n%S\n\n" here (1+ here) ovl-in))
4006 ;; (insert (format "overlays-in %s-%s:\n%S\n\n" here here ovl-in0))
4008 ;; (defun temp-cursor-pos ()
4010 ;; (what-cursor-position t))
4011 ;; ;;(global-set-key [f9] 'temp-cursor-pos)
4012 ;; (defun temp-test-new-create-chunk ()
4014 ;; (mumamo-delete-new-chunks)
4018 ;; (while (or first x1)
4020 ;; (setq x1 (mumamo-new-create-chunk (mumamo-find-next-chunk-values x1 nil nil nil)))))
4023 ;; (defun temp-create-last-chunk ()
4025 ;; (mumamo-new-create-chunk (mumamo-find-next-chunk-values mumamo-last-chunk nil nil nil)))
4027 (defun mumamo-delete-new-chunks ()
4028 (setq mumamo-last-chunk nil)
4031 (let ((ovls (overlays-in (point-min) (point-max))))
4033 (when (overlay-get ovl 'mumamo-is-new)
4034 ;;(msgtrc "delete-overlay %s delete-new-chunks" ovl)
4035 (delete-overlay ovl))))))
4037 (defun mumamo-new-create-chunk (new-chunk-values)
4038 "Create and return a chunk from NEW-CHUNK-VALUES.
4039 When doing this store the functions for creating the next chunk
4040 after this in the properties below of the now created chunk:
4042 - 'mumamo-next-major: is nil or the next chunk's major mode.
4043 - 'mumamo-next-end-fun: function that searches for end of AFTER-CHUNK
4044 - 'mumamo-next-border-fun: functions that finds borders"
4045 ;;((1 696 nxhtml-mode nil nil nil nil) (696 nil php-mode nil nil nil nil))
4046 ;;(current (list curr-min curr-max curr-major curr-border-min curr-border-max curr-parseable curr-fw-exc-fun))
4047 ;;(msgtrc "######new-create.chunk.new-chunk-values=%s" new-chunk-values)
4048 (when new-chunk-values
4049 (let* ((this-values (nth 0 new-chunk-values))
4050 (next-values (nth 1 new-chunk-values))
4051 (next-major (nth 0 next-values))
4052 (next-end-fun (nth 1 next-values))
4053 (next-border-fun (nth 2 next-values))
4054 (next-depth-diff (nth 3 next-values))
4055 (next-indent (nth 4 next-values))
4056 (this-beg (nth 0 this-values))
4057 (this-end (nth 1 this-values))
4058 (this-maj (nth 2 this-values))
4059 (this-bmin (nth 3 this-values))
4060 (this-bmax (nth 4 this-values))
4061 (this-pable (nth 5 this-values))
4062 (this-after-chunk (nth 7 this-values))
4063 ;;(this-is-closed (nth 8 this-values))
4064 (this-insertion-type-beg (nth 8 this-values))
4065 (this-insertion-type-end (nth 9 this-values))
4066 ;;(this-is-closed (and this-end (< 1 this-end)))
4067 (this-after-chunk-depth (when this-after-chunk
4068 (overlay-get this-after-chunk 'mumamo-depth)))
4069 (depth-diff (if this-after-chunk
4070 (overlay-get this-after-chunk 'mumamo-next-depth-diff)
4072 (depth (if this-after-chunk-depth
4073 (+ this-after-chunk-depth depth-diff)
4075 ;;(fw-funs (nth 6 this-values))
4076 ;;(borders-fun (nth 7 this-values))
4077 ;;(this-is-closed (when (or this-end (mumamo-fun-eq this-maj (mumamo-main-major-mode))) t))
4078 (use-this-end (if this-end this-end (1+ (buffer-size)))) ;(save-restriction (widen) (point-max))))
4079 (this-chunk (when (and (<= this-beg use-this-end)
4080 ;; Avoid creating two empty overlays
4081 ;; at the this-end - but what if we are
4082 ;; not creating, just changing the
4085 ;; (not (and (= this-beg use-this-end)
4086 ;; (= use-this-end (1+ (buffer-size)))
4088 ;; (= 0 (- (overlay-end this-after-chunk) (overlay-start this-after-chunk)))
4091 (when (= this-beg 1)
4092 (if (= use-this-end 1)
4093 (assert (mumamo-fun-eq (mumamo-main-major-mode) this-maj) t)
4094 (if this-after-chunk ;; not first
4095 (assert (not (mumamo-fun-eq (mumamo-main-major-mode) this-maj)) t)
4096 (assert (mumamo-fun-eq (mumamo-main-major-mode) this-maj) t))))
4097 ;;(message "Create chunk %s - %s" this-beg use-this-end)
4098 ;;(make-overlay this-beg use-this-end nil nil (not this-is-closed))
4099 (make-overlay this-beg use-this-end nil this-insertion-type-beg this-insertion-type-end)
4101 ;; Fix-me: move to mumamo-find-next-chunk-values
4102 (this-border-fun (when (and this-chunk this-after-chunk)
4103 ;;(overlay-get this-after-chunk 'mumamo-next-border-fun)
4104 (mumamo-chunk-car this-after-chunk 'mumamo-next-border-fun)
4106 (this-borders (when this-border-fun
4107 ;;(msgtrc "(funcall %s %s %s %s)" this-border-fun this-beg this-end this-maj)
4108 (funcall this-border-fun this-beg this-end this-maj)))
4109 ;; Fix-me, check: there is no first border when moving out.
4110 (this-borders-min (when (= 1 depth-diff)
4111 (nth 0 this-borders)))
4112 ;; Fix-me, check: there is no bottom border when we move
4113 ;; further "in" since borders are now always inside
4114 ;; sub-chunks (if I remember correctly...).
4115 ;;(this-borders-max (when (and this-is-closed
4116 (this-borders-max (when (and (not this-insertion-type-end)
4117 (/= 1 next-depth-diff))
4118 (nth 1 this-borders)))
4120 ;;(msgtrc "created %s, major=%s" this-chunk this-maj)
4121 (when (> depth 4) (error "Chunk depth > 4"))
4122 (setq this-bmin nil)
4123 (setq this-bmax nil)
4124 (when this-borders-min (setq this-bmin (- this-borders-min this-beg)))
4125 (when this-borders-max (setq this-bmax (- this-end this-borders-max)))
4126 ;;(when this-after-chunk (message "this-after-chunk.this-end=%s, this-beg=%s, this-end=%s" (overlay-end this-after-chunk) this-beg this-end))
4127 ;;(message "fw-funs=%s" fw-funs)
4129 (overlay-put this-chunk 'mumamo-is-new t)
4130 (overlay-put this-chunk 'face (mumamo-background-color depth))
4131 (overlay-put this-chunk 'mumamo-depth depth)
4132 ;; Values for next chunk
4133 (overlay-put this-chunk 'mumamo-next-depth-diff next-depth-diff)
4134 (assert (symbolp next-major) t)
4135 (overlay-put this-chunk 'mumamo-next-major next-major)
4136 ;; Values for this chunk
4137 ;;(overlay-put this-chunk 'mumamo-is-closed this-is-closed)
4138 (overlay-put this-chunk 'mumamo-insertion-type-end this-insertion-type-end)
4139 (overlay-put this-chunk 'mumamo-syntax-min-d this-bmin)
4140 (overlay-put this-chunk 'mumamo-syntax-max-d this-bmax)
4141 (overlay-put this-chunk 'mumamo-prev-chunk this-after-chunk)
4142 (overlay-put this-chunk 'mumamo-next-indent next-indent)
4143 (when this-after-chunk (overlay-put this-after-chunk 'mumamo-next-chunk this-chunk))
4145 ;;(msgtrc "\n<<<<<<<<<<<<<<<<< next-depth-diff/depth-diff=%s/%s, this-maj=%s, this-after-chunk=%s" next-depth-diff depth-diff this-maj this-after-chunk)
4146 ;;(overlay-put this-chunk 'mumamo-next-end-fun next-end-fun)
4148 ((= 1 next-depth-diff)
4149 (mumamo-chunk-push this-chunk 'mumamo-next-border-fun next-border-fun)
4150 (mumamo-chunk-push this-chunk 'mumamo-next-end-fun next-end-fun))
4151 ((= -1 next-depth-diff)
4152 (mumamo-chunk-pop this-chunk 'mumamo-next-border-fun)
4153 (mumamo-chunk-pop this-chunk 'mumamo-next-end-fun))
4154 ((= 0 next-depth-diff)
4156 (t (error "next-depth-diff=%s" next-depth-diff)))
4157 ;;(msgtrc "mumamo-next-end-fun=%S" (overlay-get this-chunk 'mumamo-next-end-fun))
4159 ;; Fix-me: replace 'mumamo-major-mode with multi major mode to make it more flexible.
4162 (mumamo-chunk-push this-chunk 'mumamo-major-mode this-maj))
4164 (mumamo-chunk-pop this-chunk 'mumamo-major-mode)
4166 (t (error "depth-diff=%s" depth-diff)))
4168 (overlay-put this-chunk 'mumamo-parseable-by this-pable)
4169 (overlay-put this-chunk 'created (current-time-string))
4170 (mumamo-update-chunk-margin-display this-chunk)
4171 (setq mumamo-last-chunk this-chunk) ;; Use this chunk!!!!
4172 ;; Get syntax-begin-function for syntax-ppss:
4173 (let* ((syntax-begin-function
4174 (mumamo-with-major-mode-fontification this-maj
4175 ;; Do like in syntax.el:
4176 '(if syntax-begin-function
4178 syntax-begin-function)
4179 (when (and (not syntax-begin-function)
4180 ;; fix-me: How to handle boundp here?
4181 (boundp 'font-lock-beginning-of-syntax-function)
4182 font-lock-beginning-of-syntax-function)
4183 font-lock-beginning-of-syntax-function)))))
4184 (mumamo-msgfntfy "Got syntax-begin-function, modified=%s" (buffer-modified-p))
4185 (overlay-put this-chunk 'syntax-begin-function syntax-begin-function))
4187 ;;(msgtrc "Created %s, this=%s, next=%s" this-chunk this-values next-values)
4192 (defun mumamo-update-chunk-margin-display (chunk)
4193 "Set before-string of CHUNK as spec by `mumamo-margin-use'."
4194 ;; Fix-me: This is not displayed. Emacs bug?
4195 ;;(overlay-put this-chunk 'before-string `((margin left-margin) ,(format "%d %s" depth maj)))
4196 (if (not mumamo-margin-info-mode)
4197 (overlay-put chunk 'before-string nil)
4198 (let* ((depth (overlay-get chunk 'mumamo-depth))
4199 (maj (mumamo-chunk-car chunk 'mumamo-major-mode))
4200 (strn (propertize (format "%d" depth)
4201 'face (list :inherit (or (mumamo-background-color depth)
4203 :foreground "#505050"
4208 (maj-name (substring (symbol-name maj) 0 -5))
4209 (strm (propertize maj-name 'face
4210 (list :foreground "#a0a0a0" :underline nil
4211 :background (frame-parameter nil 'background-color)
4215 (margin (mumamo-margin-used)))
4216 (when (> (length strm) 5) (setq strm (substring strm 0 5)))
4217 (setq str (concat strn
4219 (propertize " " 'face 'default)
4221 (overlay-put chunk 'before-string
4222 (propertize " " 'display
4223 `((margin ,margin) ,str))))))
4225 (defun mumamo-update-chunks-margin-display (buffer)
4226 "Apply `update-chunk-margin-display' to all chunks in BUFFER."
4227 (with-current-buffer buffer
4230 (let ((chunk (mumamo-find-chunks 1 "margin-disp"))
4232 (while (and (mumamo-while 1500 'while-n0 "chunk")
4234 (mumamo-update-chunk-margin-display chunk)
4235 (setq chunk (overlay-get chunk 'mumamo-next-chunk)))))))
4237 (defvar mumamo-margin-used nil)
4238 (make-variable-buffer-local 'mumamo-margin-used)
4239 (put 'mumamo-margin-used 'permanent-local t)
4241 (defun mumamo-margin-used ()
4242 (setq mumamo-margin-used
4243 (if (and (boundp 'linum-mode) linum-mode) 'right-margin (nth 0 mumamo-margin-use))))
4245 ;; (defun mumamo-set-window-margins-used (win)
4246 ;; "Set window margin according to `mumamo-margin-use'."
4247 ;; ;; Fix-me: old-margin does not work, break it up
4248 ;; (let* ((old-margin-used mumamo-margin-used)
4249 ;; (margin-used (mumamo-margin-used))
4250 ;; (width (nth 1 mumamo-margin-use))
4251 ;; (both-widths (window-margins win))
4252 ;; (old-left (eq old-margin-used 'left-margin))
4253 ;; (left (eq margin 'left-margin)))
4254 ;; ;; Change only the margin we used!
4255 ;; (if (not mumamo-margin-info-mode)
4257 ;; (set-window-margins win
4258 ;; (if left nil (car both-widths))
4259 ;; (if (not left) nil (cdr both-widths)))
4261 ;; ;;(msgtrc "set-window-margins-used margin-info-mode=t")
4262 ;; (case margin-used
4263 ;; ('left-margin (set-window-margins win width (when old-left (cdr both-widths))))
4264 ;; ('right-margin (set-window-margins win (car both-widths) width))))))
4266 (defun mumamo-update-buffer-margin-use (buffer)
4267 ;;(msgtrc "update-buffer-margin-use %s" buffer)
4268 (when (fboundp 'mumamo-update-chunks-margin-display)
4269 (with-current-buffer buffer
4270 (when mumamo-multi-major-mode
4271 (let* ((old-margin-used mumamo-margin-used)
4272 (margin-used (mumamo-margin-used))
4273 (old-is-left (eq old-margin-used 'left-margin))
4274 (is-left (eq margin-used 'left-margin))
4275 (width (nth 1 mumamo-margin-use))
4277 (if (not mumamo-margin-info-mode)
4278 (when old-margin-used
4279 (setq need-update t)
4280 (setq old-margin-used nil)
4282 (setq left-margin-width 0)
4283 (setq right-margin-width 0)))
4284 (unless (and (eq old-margin-used margin-used)
4285 (= width (if old-is-left left-margin-width right-margin-width)))
4286 (setq need-update t)
4288 (setq left-margin-width width)
4289 (setq right-margin-width width))
4290 (unless (eq old-margin-used margin-used)
4292 (setq left-margin-width 0)
4293 (setq right-margin-width 0)))))
4295 (mumamo-update-chunks-margin-display buffer)
4296 (dolist (win (get-buffer-window-list buffer))
4297 (set-window-buffer win buffer)))
4299 ;; Note: window update must be before buffer update because it
4300 ;; uses old-margin from the call to function margin-used.
4301 ;; (dolist (win (get-buffer-window-list buffer))
4302 ;; (mumamo-set-window-margins-used win))
4303 ;; (mumamo-update-chunks-margin-display buffer)
4306 (defun mumamo-new-chunk-value-min (values)
4307 (let ((this-values (nth 0 values)))
4308 (nth 0 this-values)))
4310 (defun mumamo-new-chunk-value-max (values)
4311 (let ((this-values (nth 0 values)))
4312 (nth 1 this-values)))
4314 (defun mumamo-new-chunk-equal-chunk-values (chunk values)
4315 ;;(msgtrc "eq? chunk=%S, values=%S" chunk values)
4317 (chunk-is-new (overlay-get chunk 'mumamo-is-new))
4318 ;;(chunk-is-closed (overlay-get chunk 'mumamo-is-closed))
4319 (chunk-insertion-type-end (overlay-get chunk 'mumamo-insertion-type-end))
4320 (chunk-next-major (overlay-get chunk 'mumamo-next-major))
4321 (chunk-next-end-fun (mumamo-chunk-car chunk 'mumamo-next-end-fun))
4322 (chunk-next-border-fun (mumamo-chunk-car chunk 'mumamo-next-border-fun))
4323 (chunk-next-chunk-diff (overlay-get chunk 'mumamo-next-depth-diff))
4324 (chunk-beg (overlay-start chunk))
4325 (chunk-end (overlay-end chunk))
4326 (chunk-bmin (overlay-get chunk 'mumamo-syntax-min-d))
4327 (chunk-bmax (overlay-get chunk 'mumamo-syntax-max-d))
4328 (chunk-prev-chunk (overlay-get chunk 'mumamo-prev-chunk))
4329 (chunk-major-mode (mumamo-chunk-car chunk 'mumamo-major-mode))
4330 (chunk-pable (overlay-get chunk 'mumamo-parseable-by))
4331 (chunk-depth-diff (if chunk-prev-chunk
4332 (overlay-get chunk-prev-chunk 'mumamo-next-depth-diff)
4335 (this-values (nth 0 values))
4336 (next-values (nth 1 values))
4337 (values-next-major (nth 0 next-values))
4338 (values-next-end-fun (nth 1 next-values))
4339 (values-next-border-fun (nth 2 next-values))
4340 (values-next-depth-diff (nth 3 next-values))
4341 (values-beg (nth 0 this-values))
4342 (values-end (nth 1 this-values))
4343 (values-major-mode (nth 2 this-values))
4344 (values-bmin (nth 3 this-values))
4345 (values-bmax (nth 4 this-values))
4346 (values-pable (nth 5 this-values))
4347 (values-prev-chunk (nth 7 this-values))
4348 (values-insertion-type-beg (nth 8 this-values))
4349 (values-insertion-type-end (nth 9 this-values))
4350 ;;(values-is-closed (when values-end t))
4352 ;;(msgtrc "values=%S" values)
4353 (and t ;chunk-is-new
4354 (eq chunk-next-major values-next-major)
4356 ;; Can't check chunk-next-end-fun or chunk-next-border-fun
4357 ;; here since they are fetched from prev chunk:
4358 ;;(progn (message "eq-c-v: here b: %s /= %s" chunk-next-end-fun values-next-end-fun) t)
4359 ;;(eq chunk-next-end-fun values-next-end-fun)
4360 ;;(progn (message "eq-c-v: here c, %s /= %s" chunk-next-border-fun values-next-border-fun) t)
4361 ;;(eq chunk-next-border-fun values-next-border-fun)
4363 (= chunk-next-chunk-diff values-next-depth-diff)
4364 (= chunk-beg values-beg)
4365 ;;(progn (message "eq-c-v: here b") t)
4366 ;; (and (equal chunk-is-closed values-is-closed)
4367 ;; (or (not chunk-is-closed)
4368 (and (equal chunk-insertion-type-end values-insertion-type-end)
4369 (or ;;chunk-insertion-type-end
4370 (= chunk-end values-end)))
4371 ;;(progn (message "eq-c-v: here c, %s /= %s" chunk-major-mode values-major-mode) t)
4372 (or (= -1 chunk-depth-diff)
4373 (eq chunk-major-mode values-major-mode))
4374 ;;(progn (message "eq-c-v: here d") t)
4375 (equal chunk-pable values-pable)
4376 ;;(progn (message "eq-c-v: here e") t)
4377 (eq chunk-prev-chunk values-prev-chunk)
4378 ;;(progn (message "eq-c-v: here f") t)
4379 ;;(eq chunk-is-closed values-is-closed)
4380 (eq chunk-insertion-type-end values-insertion-type-end)
4381 ;; fix-me: bmin bmax
4382 ;;(and chunk-bmin values-bmin (= chunk-bmin values-bmin))
4383 ;;(and chunk-bmax values-bmax (= chunk-bmax values-bmax))
4387 (defvar mumamo-sub-chunk-families nil
4388 "Chunk dividing routines for sub chunks.
4389 A major mode in a sub chunk can inherit chunk dividing routines
4390 from multi major modes. This is the way chunks in chunks is
4393 This variable is an association list with entries of the form
4395 \(CHUNK-MAJOR CHUNK-FAMILY)
4397 where CHUNK-MAJOR is the major mode in a chunk and CHUNK-FAMILY
4398 is a chunk family \(ie the third argument to
4399 `define-mumamo-multi-major-mode'.
4401 You can use the function `mumamo-inherit-sub-chunk-family' to add
4404 (defvar mumamo-multi-local-sub-chunk-families nil
4405 "Multi major mode local chunk dividing rourines for sub chunks.
4406 Like `mumamo-sub-chunk-families' specific additions for multi
4407 major modes. The entries have the form
4409 \((CHUNK-MAJOR . MULTI-MAJOR) CHUNK-FAMILY)
4411 Use the function `mumamo-inherit-sub-chunk-family-locally' to add
4414 ;;(mumamo-get-sub-chunk-funs 'html-mode)
4415 (defun mumamo-get-sub-chunk-funs (major)
4416 "Get chunk family sub chunk with major mode MAJOR."
4418 (assoc (cons major mumamo-multi-major-mode) mumamo-multi-local-sub-chunk-families)
4419 (assoc major mumamo-sub-chunk-families))))
4420 (caddr (cadr rec))))
4422 (defun mumamo-inherit-sub-chunk-family-locally (multi-major multi-using)
4423 "Add chunk dividing routines from MULTI-MAJOR locally.
4424 The dividing routines from multi major mode MULTI-MAJOR can then
4425 be used in sub chunks in buffers using multi major mode
4427 (let* ((chunk-family (get multi-major 'mumamo-chunk-family))
4428 (major (nth 1 chunk-family)))
4429 (let ((major-mode major))
4430 (when (derived-mode-p 'nxml-mode)
4431 (error "Major mode %s major can't be used in sub chunks" major)))
4432 (add-to-list 'mumamo-multi-local-sub-chunk-families
4433 (list (cons major multi-using) chunk-family))))
4435 (defun mumamo-inherit-sub-chunk-family (multi-major)
4436 "Inherit chunk dividing routines from multi major modes.
4437 Add chunk family from multi major mode MULTI-MAJOR to
4438 `mumamo-sub-chunk-families'.
4440 Sub chunks with major mode the same as MULTI-MAJOR mode will use
4441 this chunk familyu to find subchunks."
4442 (let* ((chunk-family (get multi-major 'mumamo-chunk-family))
4443 (major (nth 1 chunk-family)))
4444 (let ((major-mode major))
4445 (when (derived-mode-p 'nxml-mode)
4446 (error "Major mode %s major can't be used in sub chunks" major)))
4447 (add-to-list 'mumamo-sub-chunk-families (list major chunk-family))))
4449 (defun mumamo-find-next-chunk-values (after-chunk from after-change-max chunk-at-after-change)
4450 "Search forward for start of next chunk.
4451 Return a list with chunk values for next chunk after AFTER-CHUNK
4452 and some values for the chunk after it.
4454 For the first chunk AFTER-CHUNK is nil. Otherwise the values in stored in AFTER-CHUNK
4455 is used to find the new chunk, its border etc.
4458 See also `mumamo-new-create-chunk' for more information."
4459 ;;(msgtrc "(find-next-chunk-values %s %s %s %s)" after-chunk from after-change-max chunk-at-after-change)
4460 ;;(mumamo-backtrace "find-next")
4462 (unless (eq (overlay-buffer after-chunk)
4464 (error "mumamo-find-next-chunk-values: after-chunk=%S, cb=%S" after-chunk (current-buffer))))
4465 (let* ((here (point))
4467 ;;(after-chunk-is-closed (when after-chunk-valid (overlay-get after-chunk 'mumamo-is-closed)))
4468 (after-chunk-insertion-type-end (when after-chunk (overlay-get after-chunk 'mumamo-insertion-type-end)))
4469 ;; Note that "curr-*" values are fetched from "mumamo-next-*" values in after-chunk
4470 (curr-min (if after-chunk (overlay-end after-chunk) 1))
4471 (curr-end-fun (when after-chunk
4472 (mumamo-chunk-car after-chunk 'mumamo-next-end-fun)))
4473 (curr-border-fun (when curr-end-fun (mumamo-chunk-car after-chunk 'mumamo-next-border-fun)))
4474 (curr-syntax-min-max (when curr-border-fun (funcall curr-border-fun
4475 (overlay-end after-chunk)
4477 (curr-syntax-min (or (car curr-syntax-min-max)
4478 (when after-chunk (overlay-end after-chunk))
4480 (search-from (or nil ;from
4482 ;;(dummy (msgtrc "search-from=%s" search-from))
4483 (main-chunk-funs (let ((chunk-info (cdr mumamo-current-chunk-family)))
4485 (curr-major (if after-chunk
4487 ;; 'mumamo-next-major is used when we are going into a sub chunk.
4488 (overlay-get after-chunk 'mumamo-next-major)
4489 ;; We are going out of a sub chunk.
4490 (mumamo-chunk-cadr after-chunk 'mumamo-major-mode))
4491 (mumamo-main-major-mode)))
4492 ;;(dummy (msgtrc "curr-major=%s" curr-major))
4494 (if (or (not after-chunk)
4495 (= 0 (+ (overlay-get after-chunk 'mumamo-depth)
4496 (overlay-get after-chunk 'mumamo-next-depth-diff))))
4498 (mumamo-get-sub-chunk-funs curr-major)))
4511 ;; The insertion types for the new chunk
4512 (curr-insertion-type-beg (when after-chunk after-chunk-insertion-type-end))
4513 curr-insertion-type-end
4517 (unless (and after-chunk-insertion-type-end
4518 (= (1+ (buffer-size)) ;; ie point-max
4519 (overlay-end after-chunk)))
4520 (when (>= max search-from)
4522 ;; If after-change-max is non-nil here then this function has
4523 ;; been called after changes that are all in one chunk. We
4524 ;; need to check if the chunk right border have been changed,
4525 ;; but we do not have to look much longer than the max point
4527 ;;(message "set after-change-max nil") (setq after-change-max nil)
4528 (let* ((use-max (if nil ;;after-change-max
4529 (+ after-change-max 100)
4531 (chunk-end (and chunk-at-after-change
4532 (overlay-end chunk-at-after-change)))
4533 ;;(use-min (max (- search-from 2) (point-min)))
4534 (use-min curr-syntax-min)
4535 (possible-end-fun-end t)
4536 (end-search-pos use-min))
4537 ;; The code below takes care of the case when to subsequent
4538 ;; chunks have the same ending delimiter. (Maybe a while
4539 ;; loop is bit overkill here.)
4540 (while (and possible-end-fun-end
4541 (not curr-end-fun-end)
4542 (< end-search-pos use-max))
4543 (setq curr-end-fun-end (funcall curr-end-fun end-search-pos use-max))
4544 (if (not curr-end-fun-end)
4545 (setq possible-end-fun-end nil)
4546 (cond ((and t ;after-chunk-is-closed
4547 (< curr-end-fun-end (overlay-end after-chunk)))
4548 (setq curr-end-fun-end nil)
4549 (setq end-search-pos (1+ end-search-pos)))
4550 ;; See if the end is in code
4551 ((let* ((syn2-min-max (when curr-border-fun
4552 (funcall curr-border-fun
4553 (overlay-end after-chunk)
4556 (syn2-max (or (cadr syn2-min-max)
4558 (not (mumamo-end-in-code use-min syn2-max curr-major)))
4559 (setq end-search-pos (1+ curr-end-fun-end))
4560 (setq curr-end-fun-end nil)
4562 (unless curr-end-fun-end
4563 ;; Use old end if valid
4564 (and after-change-max
4566 (= -1 (overlay-get chunk-at-after-change 'mumamo-next-depth-diff))
4567 (< after-change-max chunk-end)
4569 ;; Fix-me: Check if old chunk is valid. It is not valid if
4570 ;; depth-diff = -1 and curr-end-fun-end is not the same as
4573 ;; Fix-me: this test should also be made for other chunks
4574 ;; searches, but this catches most problems I think.
4575 ;; (or (not curr-end-fun-end)
4576 ;; ;; Fix-me: The bug in wiki-090804-js.html indicates that
4577 ;; ;; we should not subtract 1 here. The subchunk there
4578 ;; ;; ends with </script> and this can't be in column 1
4579 ;; ;; when the line before ends with a // style js comment
4580 ;; ;; unless we don't subtract 1.
4582 ;; ;; However wiki-strange-hili-080629.html does not work
4583 ;; ;; then because then the final " in style="..." is
4584 ;; ;; included in the scan done in mumamo-end-in-code.
4586 ;; ;; The solution is to check for the syntax borders here.
4587 ;; (let* ((syn2-min-max (when curr-border-fun
4588 ;; (funcall curr-border-fun
4589 ;; (overlay-end after-chunk)
4592 ;; (syntax-max (or (cadr syn2-min-max)
4593 ;; curr-end-fun-end)))
4594 ;; ;;(mumamo-end-in-code syntax-min (- curr-end-fun-end 1) curr-major)
4596 ;; ;; fix-me: This should be really in the individual
4597 ;; ;; routines that finds possible chunks. Mabye this is
4598 ;; ;; possible to fix now when just looking forward for
4600 ;; (mumamo-end-in-code curr-syntax-min syntax-max curr-major)
4602 ;; (setq curr-end-fun-end nil))
4603 ;; Use old result if valid
4604 ;; (and nil ;(not curr-end-fun-end)
4605 ;; chunk-at-after-change
4606 ;; (= -1 (overlay-get chunk-at-after-change 'mumamo-next-depth-diff))
4607 ;; (setq curr-end-fun-end (overlay-end chunk-at-after-change)))
4608 ;;(msgtrc "find-next-chunk-values:curr-end-fun-end after end-in-code=%s" curr-end-fun-end)
4610 ;;(msgtrc "find-next-chunk-values:here d, curr-min=%s, after-chunk=%s" curr-min after-chunk)
4611 (when (listp curr-chunk-funs)
4612 ;;(msgtrc "find-next-chunk-values:curr-chunk-funs=%s" curr-chunk-funs)
4613 (setq r-point (point))
4614 (dolist (fn curr-chunk-funs)
4615 ;;(msgtrc "find-next-chunk-values:before (r (funcall fn search-from search-from max)), fn=%s search-from=%s, max=%s" fn search-from max)
4616 (assert (= r-point (point)) t)
4617 (let* ((r (funcall fn search-from search-from max))
4620 (rmajor-sub (nth 2 r))
4622 (rparseable (nth 4 r))
4623 (rfw-exc-fun (nth 5 r))
4624 (rborder-fun (nth 6 r))
4626 (rborder-min (when rborder (nth 0 rborder)))
4627 (rborder-max (when rborder (nth 1 rborder)))
4630 ;;(msgtrc "find-next-chunk-values:fn=%s, r=%s" fn r)
4633 (when rmax (message "mumamo warning: Bad r=%s, nth 1 should be nil" r))
4634 (unless (or rmin rmax)
4635 (error "Bad r=%s, fn=%s" r fn))
4637 (error "No fw-exc-fun returned from fn=%s, r=%s" fn r))
4639 (error "No major mode for sub chunk, fn=%s, r=%s" fn r)))
4641 (mumamo-msgfntfy " fn=%s, r=%s" fn r)
4642 (unless rmin (setq rmin (point-max)))
4643 ;;(unless rmax (setq rmax (point-min)))
4644 ;; Do not allow zero length chunks
4645 (unless rmax (setq rmax (point-max)))
4646 (unless (and (> rmin 1)
4649 ;; comparision have to be done differently if we are in an
4650 ;; exception part or not. since we are doing this from top to
4651 ;; bottom the rules are:
4653 ;; - exception parts always outrules non-exception part. when
4654 ;; in exception part the min start point should be used.
4655 ;; - when in non-exception part the max start point and the
4656 ;; min end point should be used.
4658 ;; check if first run:
4660 ;; Fix-me: there is some bug here when borders are not
4661 ;; included and are not 0 width.
4664 (setq next-min rmin)
4665 (setq curr-border-min rborder-min)
4666 (setq next-max rmax)
4667 (setq curr-border-max rborder-max)
4668 ;;(setq curr-max-found rmin-found)
4669 (setq curr-parseable rparseable)
4670 (setq next-fw-exc-fun rfw-exc-fun)
4671 (setq next-border-fun rborder-fun)
4672 (setq next-indent rindent)
4673 (setq next-major rmajor-sub))
4676 (when (or (not next-min)
4678 (setq next-min rmin)
4679 (setq curr-border-min rborder-min)
4680 (when rmax (setq max rmax))
4681 (setq curr-border-max rborder-max)
4682 ;;(when rmin-found (setq curr-max-found t))
4683 (setq curr-parseable rparseable)
4684 (setq next-fw-exc-fun rfw-exc-fun)
4685 (setq next-border-fun rborder-fun)
4686 (setq next-indent rindent)
4687 (setq next-major rmajor-sub))
4688 (setq next-min rmin)
4689 (setq curr-border-min rborder-min)
4690 (when rmax (setq max rmax))
4691 (setq curr-border-max rborder-max)
4692 ;;(when rmin-found (setq curr-max-found t))
4693 (setq curr-parseable rparseable)
4694 (setq next-fw-exc-fun rfw-exc-fun)
4695 (setq next-border-fun rborder-fun)
4696 (setq next-indent rindent)
4697 (setq next-major rmajor-sub))
4699 (when (> next-min rmin)
4700 (setq next-min rmin)
4701 (setq curr-border-min rborder-min))
4704 ;;(setq max-found rmin-found)
4705 ;;(when rmin-found (setq curr-max-found t))
4706 (when rmax (setq max rmax))
4707 (setq curr-border-max rborder-max))
4709 (mumamo-msgfntfy "next-min/max=%s/%s border=%s/%s search-from=%s" next-min max curr-border-min curr-border-max search-from)
4711 (when (and next-min max)
4712 ;;(assert (>= next-min search-from) t)
4713 (assert (<= search-from max) t)
4714 (when curr-border-min
4715 (assert (<= next-min curr-border-min) t)
4716 (assert (<= curr-border-min max) t))
4717 (when curr-border-max
4718 (assert (<= next-min curr-border-max) t)
4719 (assert (<= curr-border-max max) t))))
4722 (setq curr-max-found (or curr-max-found curr-end-fun-end))
4723 (when t ;curr-max-found
4724 (setq curr-max (if max max (point-max)))
4725 (setq curr-max (min (if next-min next-min curr-max)
4726 (if curr-end-fun-end curr-end-fun-end curr-max))))
4727 ;;(setq curr-max nil)
4728 (setq next-depth-diff (cond
4729 ( (and curr-max curr-end-fun-end
4730 (= curr-max curr-end-fun-end))
4732 ( (= curr-max (1+ (buffer-size)))
4735 (when (= -1 next-depth-diff) ;; We will pop it from 'mumamo-major-mode
4736 (setq next-major nil))
4738 (unless (>= curr-max curr-min)
4739 (error "curr-max is not >= curr-min")))
4740 ;;(setq curr-is-closed (and curr-max (< 1 curr-max)))
4741 (when (and curr-max (= 1 curr-max))
4742 (assert (mumamo-fun-eq curr-major (mumamo-main-major-mode)) t)
4744 (assert (symbolp next-major) t)
4745 ;; Fix-me: see for example rr-min8.php
4746 (when (or ;;(not after-chunk)
4747 (= curr-max (1+ (buffer-size)))
4749 ((= next-depth-diff 1)
4751 ((= next-depth-diff -1)
4753 ((= next-depth-diff 0)
4755 (t (error "next-depth-diff=%s" next-depth-diff))))
4756 (setq curr-insertion-type-end t))
4757 (let ((current (list curr-min curr-max curr-major curr-border-min curr-border-max curr-parseable
4758 curr-chunk-funs after-chunk
4760 curr-insertion-type-beg
4761 curr-insertion-type-end
4763 (next (list next-major next-fw-exc-fun next-border-fun next-depth-diff next-indent)))
4764 ;;(msgtrc "find-next-chunk-values=> current=%s, next=%s" current next)
4765 (list current next))))))
4767 ;; Fix-me: This should check if the new chunk should be
4769 ;; (defsubst mumamo-chunk-nxml-parseable (chunk)
4770 ;; (mumamo-fun-eq (mumamo-main-major-mode)
4771 ;; (mumamo-chunk-major-mode xml-chunk)))
4773 (defun mumamo-valid-nxml-point (pos)
4774 "Return non-nil if position POS is in an XML chunk."
4775 (memq 'nxml-mode (get-text-property pos 'mumamo-parseable-by)))
4777 (defun mumamo-valid-nxml-chunk (chunk)
4778 "Return t if chunk CHUNK should be valid XML."
4780 (let ((major-mode (mumamo-chunk-major-mode chunk))
4781 (region (overlay-get chunk 'mumamo-region))
4782 (parseable-by (overlay-get chunk 'mumamo-parseable-by)))
4783 ;;(message "mumamo-valid-nxml-chunk: major-mode=%s, parseble-by=%s" major-mode parseable-by)
4785 (derived-mode-p 'nxml-mode)
4786 (memq 'nxml-mode parseable-by)))))
4788 ;; A good test case for the use of this is the troublesome code in the
4789 ;; first line of xml-as-string.php in nxml/nxhtml/bug-tests. Currently
4790 ;; this test code is however splitted and it looks like the code below
4791 ;; can't handle the line above if the line looks like below. The ?> is
4792 ;; still thought to be a border. Does this mean that ' is not treated
4793 ;; as a string separator?
4795 ;; <?php header("Content-type:application/xml; charset=utf-8"); echo '<?xml version="1.0" encoding="utf-8"?>'; ?>
4797 ;; However there are the reverse cases also, in lines like
4799 ;; href="<?php $this->url($url); ?>"
4800 ;; <!-- <td><?php insert_a_lot_of_html(); ?>
4802 ;; These are supposedly handled by using this test at the right
4803 ;; place... However it is not very clear in all cases whether chunk
4804 ;; dividers in comments and strings should be valid or not...
4806 ;; For example in the first case above the php divider should be
4807 ;; valid. Probably it should be that in the second case too, but how
4808 ;; should mumamo know that?
4810 ;; Fix-me: I think a per "chunk divider function + context" flag is
4811 ;; needed to handle this. Probably this will work the same for all web
4812 ;; dev things, ie the opening sub chunk divider is ALWAYS
4813 ;; valid. However that is not true for things like CSS, Javascript etc
4816 (defun mumamo-end-in-code (syntax-start syntax-end major)
4817 "Return t if possible syntax end is not in a string or comment.
4818 Assume that the sexp syntax is nil at SYNTAX-START return t if
4819 position SYNTAX-END is not in a string or comment according to
4820 the sexp syntax using major mode MAJOR."
4821 ;; Fix-me: This can't always detect html comments: <!--
4822 ;; ... -->. Could this be solved by RMS suggestion with a
4823 ;; function/defmacro that binds variables to their global values?
4824 (mumamo-msgfntfy "point-min,max=%s,%s syntax-start,end=%s,%s, major=%s" (point-min) (point-max) syntax-start syntax-end major)
4825 ;;(msgtrc "end-in-code:here a after-chunk=%s" (when (boundp 'after-chunk) after-chunk))
4826 (assert (and syntax-start syntax-end) t)
4827 (let ((doesnt-here (point))
4831 ;;(msgtrc "end-in-code:here a2 after-chunk=%s" (when (boundp 'after-chunk) after-chunk))
4832 (mumamo-with-major-mode-fontification major
4834 ;; fix-me: Use main major mode, and `syntax-ppss'. Change the
4835 ;; defadvice of this to make that possible.
4836 ;;(msgtrc "end-in-code:here b after-chunk=%s" (when (boundp 'after-chunk) after-chunk))
4837 (setq ppss (parse-partial-sexp ,syntax-start (+ ,syntax-end 0)))
4838 ;;(msgtrc "end-in-code %s %s %s:ppss=%S" ,syntax-start ,syntax-end ',major ppss)
4839 ;;(msgtrc "end-in-code:here c after-chunk=%s" (when (boundp 'after-chunk) after-chunk))
4840 ;; If inside a string or comment then the end marker is
4842 ;;(msgtrc "mumamo-end-in-code:ppss=%s" ppss)
4843 (if (or (nth 3 ppss)
4846 ;;(msgtrc "invalid end, syntax-end =%s" syntax-end)
4847 (setq doesnt-ret nil)
4848 (if (nth 4 ppss) ;; in comment, check if single line comment
4849 (let ((here (point))
4851 ;;(msgtrc "end-in-code, was in comment, ppss=%S" ppss)
4852 (goto-char ,syntax-end)
4853 (setq eol-pos (line-end-position))
4855 (setq ppss (parse-partial-sexp ,syntax-start (+ eol-pos 1)))
4856 ;;(msgtrc "end-in-code, in comment, new ppss %s %s=%S" ,syntax-start (+ eol-pos 1) ppss)
4857 (unless (nth 4 ppss)
4858 (setq doesnt-ret t)))))
4860 ;;(msgtrc "valid end, syntax-end =%s" syntax-end)
4862 (goto-char doesnt-here)
4863 ;;(msgtrc "end-in-code:ret=%s" doesnt-ret)
4866 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
4867 ;;;; Easy chunk defining
4869 (defun mumamo-quick-chunk-forward (pos
4871 begin-mark end-mark inc mode
4873 ;;(msgtrc "quick-chunk-forward %s %s %s" pos min max)
4874 (let ((search-fw-exc-start
4878 (mumamo-chunk-start-fw-str-inc pos max ,begin-mark)
4879 (mumamo-chunk-start-fw-str pos max ,begin-mark))))
4881 (list exc-start mode nil)))))
4884 ;;(msgtrc "search-fw-exc-end %s %s, inc=%s, end-mark=%s" pos max ,inc ,end-mark)
4887 (mumamo-chunk-end-fw-str-inc pos max ,end-mark)
4888 (mumamo-chunk-end-fw-str pos max ,end-mark))))
4889 ;;(msgtrc "search-fw-exc-end ret=%s" ret)
4892 (when mark-is-border
4893 `(lambda (start end exc-mode)
4894 (let ((start-border)
4896 (if (and ,inc);; exc-mode)
4900 (+ start (length ,begin-mark))))
4903 (- end (length ,end-mark)))))
4904 (if (and (not ,inc) (not exc-mode))
4908 (+ start (length ,end-mark))))
4911 (- end (length ,begin-mark)))))))
4912 (when (or start-border end-border)
4913 (mumamo-msgfntfy "quick.start-border/end=%s/%s, start/end=%s/%s exc-mode=%s" start-border end-border start end exc-mode)
4914 (list start-border end-border)))))))
4915 (mumamo-possible-chunk-forward pos max
4920 (defun mumamo-quick-static-chunk (pos
4922 begin-mark end-mark inc mode
4925 (mumamo-quick-chunk-forward pos min max begin-mark end-mark inc mode mark-is-border)
4926 ;; (let ((old (mumamo-quick-static-chunk-old pos min max begin-mark end-mark inc mode mark-is-border))
4927 ;; (new (mumamo-quick-chunk-forward pos min max begin-mark end-mark inc mode mark-is-border)))
4928 ;; (unless (equal old new) (msgtrc "equal=%s\n\told=%S\n\tnew=%S" (equal old new) old new))
4929 ;; (if nil old new))
4932 ;; (defun mumamo-quick-static-chunk-old (pos
4934 ;; begin-mark end-mark inc mode
4936 ;; "Quick way to make a chunk function with static dividers.
4937 ;; Here is an example of how to use it:
4939 ;; (defun mumamo-chunk-embperl-<- (pos min max)
4940 ;; \"Find [- ... -], return range and perl-mode.\"
4941 ;; (mumamo-quick-static-chunk pos min max \"[-\" \"-]\" nil 'perl-mode))
4943 ;; As you can see POS, MIN and MAX comes from argument of the
4944 ;; function you define.
4946 ;; BEGIN-MARK should be a string that begins the chunk.
4947 ;; END-MARK should be a string that ends the chunk.
4949 ;; If INC is non-nil then the dividers are included in the chunk.
4950 ;; Otherwise they are instead made parts of the surrounding chunks.
4952 ;; MODE should be the major mode for the chunk.
4954 ;; If MARK-IS-BORDER is non-nil then the marks are just borders and
4955 ;; not supposed to have the same syntax as the inner part of the
4957 ;; Fix-me: This can only be useful if the marks are included in the
4958 ;; chunk, ie INC is non-nil. Should not these two arguments be
4961 ;; (mumamo-msgfntfy "quick.pos=%s min,max=%s,%s begin-mark/end=%s/%s mark-is-border=%s" pos min max begin-mark end-mark mark-is-border)
4962 ;; (let ((search-bw-exc-start
4963 ;; `(lambda (pos min)
4966 ;; (mumamo-chunk-start-bw-str-inc pos min begin-mark)
4967 ;; (mumamo-chunk-start-bw-str pos min begin-mark))))
4968 ;; (when (and exc-start
4969 ;; (<= exc-start pos))
4970 ;; (cons exc-start mode)))))
4971 ;; (search-bw-exc-end
4972 ;; `(lambda (pos min)
4974 ;; (mumamo-chunk-end-bw-str-inc pos min ,end-mark)
4975 ;; (mumamo-chunk-end-bw-str pos min ,end-mark))))
4976 ;; (search-fw-exc-start
4977 ;; `(lambda (pos max)
4979 ;; (mumamo-chunk-start-fw-str-inc pos max ,begin-mark)
4980 ;; (mumamo-chunk-start-fw-str pos max ,begin-mark))))
4981 ;; (search-fw-exc-end
4982 ;; `(lambda (pos max)
4985 ;; (mumamo-chunk-end-fw-str-inc pos max ,end-mark)
4986 ;; (mumamo-chunk-end-fw-str pos max ,end-mark)))))
4988 ;; (when mark-is-border
4989 ;; `(lambda (start end exc-mode)
4990 ;; (let ((start-border)
4992 ;; (if (and ,inc exc-mode)
4995 ;; (setq start-border
4996 ;; (+ start (length ,begin-mark))))
4999 ;; (- end (length ,end-mark)))))
5000 ;; (if (and (not ,inc) (not exc-mode))
5003 ;; (setq start-border
5004 ;; (+ start (length ,end-mark))))
5007 ;; (- end (length ,begin-mark)))))))
5008 ;; (when (or start-border end-border)
5009 ;; (mumamo-msgfntfy "quick.start-border/end=%s/%s, start/end=%s/%s exc-mode=%s" start-border end-border start end exc-mode)
5010 ;; (list start-border end-border)))))))
5011 ;; (mumamo-find-possible-chunk pos min max
5012 ;; search-bw-exc-start
5013 ;; search-bw-exc-end
5014 ;; search-fw-exc-start
5015 ;; search-fw-exc-end
5020 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5021 ;;;; Changing the major mode that the user sees
5023 (defvar mumamo-unread-command-events-timer nil)
5024 (make-variable-buffer-local 'mumamo-unread-command-events-timer)
5026 (defun mumamo-unread-command-events (command-keys new-major old-last-command)
5027 "Sync new keymaps after changing major mode in a timer.
5028 Also tell new major mode.
5030 COMMAND-KEYS is the keys entered after last command and the call
5031 to `mumamo-idle-set-major-mode' \(which is done in an idle
5032 timer). Those keys are added to `unread-command-events' so they
5033 can be used in the new keymaps. They should be in the format
5036 \(listify-key-sequence (this-command-keys-vector))
5038 NEW-MAJOR mode is the new major mode.
5040 OLD-LAST-COMMAND is the value of `last-command' after switching
5041 major mode. \(This is cleared by the function `top-level' so
5042 this function will not see it since it is run in a timer.)"
5043 (mumamo-condition-case err
5045 ;; last-command seems to be cleared by top-level so set it
5047 (unless last-command
5048 (setq last-command old-last-command))
5049 (when (< 0 (length command-keys))
5050 ;;(setq last-command-char nil) ;; For `viper-command-argument'
5051 (setq unread-command-events (append command-keys nil)))
5052 (message "Switched to %s" new-major))
5054 (let ((mumamo-display-error-lwarn t))
5055 (mumamo-display-error 'mumamo-unread-command-events "err=%s" err)))))
5057 (defvar mumamo-idle-set-major-mode-timer nil)
5058 (make-variable-buffer-local 'mumamo-idle-set-major-mode-timer)
5059 (put 'mumamo-idle-set-major-mode-timer 'permanent-local t)
5061 (defun mumamotemp-pre-command ()
5062 "Temporary command for debugging."
5063 (message "mumamotemp-pre 1: modified=%s %s" (buffer-modified-p) (current-buffer)))
5064 (defun mumamotemp-post-command ()
5065 "Temporary command for debugging."
5066 (message "mumamotemp-post 1: modified=%s %s" (buffer-modified-p) (current-buffer)))
5067 (put 'mumamotemp-pre-command 'permanent-local-hook t)
5068 (put 'mumamotemp-post-command 'permanent-local-hook t)
5069 (defun mumamotemp-start ()
5070 "Temporary command for debugging."
5071 (add-hook 'post-command-hook 'mumamotemp-post-command nil t)
5072 (add-hook 'pre-command-hook 'mumamotemp-pre-command nil t))
5074 (defsubst mumamo-cancel-idle-set-major-mode ()
5075 (when (timerp mumamo-idle-set-major-mode-timer)
5076 (cancel-timer mumamo-idle-set-major-mode-timer))
5077 (setq mumamo-idle-set-major-mode-timer nil))
5079 (defun mumamo-request-idle-set-major-mode ()
5080 "Setup to change major mode from chunk when Emacs is idle."
5081 (mumamo-cancel-idle-set-major-mode)
5082 (setq mumamo-idle-set-major-mode-timer
5083 (run-with-idle-timer
5084 mumamo-set-major-mode-delay
5086 'mumamo-idle-set-major-mode (current-buffer) (selected-window))))
5088 (defvar mumamo-done-first-set-major nil)
5089 (make-variable-buffer-local 'mumamo-done-first-set-major)
5090 (put 'mumamo-done-first-set-major 'permanent-local t)
5092 ;; Fix-me: Add a property to the symbol instead (like in CUA).
5093 (defvar mumamo-safe-commands-in-wrong-major
5094 '(self-insert-command
5095 fill-paragraph ;; It changes major mode
5108 move-beginning-of-line
5110 nonincremental-search-forward
5111 nonincremental-search-backward
5112 mumamo-backward-chunk
5113 mumamo-forward-chunk
5118 (defun mumamo-fetch-local-map (major)
5119 "Fetch local keymap for major mode MAJOR.
5120 Do that by turning on the major mode in a new buffer. Add the
5121 keymap to `mumamo-major-modes-local-maps'.
5123 Return the fetched local map."
5127 (setq temp-buf-name (concat "mumamo-fetch-major-mode-local-"
5128 (symbol-name major)))
5129 (setq temp-buf (get-buffer temp-buf-name))
5130 (when temp-buf (kill-buffer temp-buf))
5131 (setq temp-buf (get-buffer-create temp-buf-name))
5132 (with-current-buffer temp-buf
5133 (let ((mumamo-fetching-major t))
5135 (setq local-map (current-local-map))
5136 (when local-map (setq local-map (copy-keymap (current-local-map))))
5137 (add-to-list 'mumamo-major-modes-local-maps
5138 (cons major-mode local-map)))
5139 (kill-buffer temp-buf)
5142 (defvar mumamo-post-command-chunk nil)
5143 (make-variable-buffer-local 'mumamo-post-command-chunk)
5145 (defun mumamo-post-command-get-chunk (pos)
5146 "Get chunk at POS fast."
5147 (let ((have-regions (and (boundp 'mumamo-regions)
5149 (when have-regions (setq mumamo-post-command-chunk nil))
5150 (if (and mumamo-post-command-chunk
5151 (overlayp mumamo-post-command-chunk)
5152 ;;(progn (message "here a=%s" mumamo-post-command-chunk) t)
5153 (overlay-buffer mumamo-post-command-chunk)
5154 ;;(progn (message "here b=%s" mumamo-post-command-chunk) t)
5155 (< pos (overlay-end mumamo-post-command-chunk))
5156 ;;(progn (message "here c=%s" mumamo-post-command-chunk) t)
5157 (>= pos (overlay-start mumamo-post-command-chunk))
5158 ;;(progn (message "here d=%s" mumamo-post-command-chunk) t)
5159 (mumamo-chunk-major-mode mumamo-post-command-chunk)
5160 ;;(progn (msgtrc "here e=%s" mumamo-post-command-chunk) t)
5162 mumamo-post-command-chunk
5163 ;;(msgtrc "--------------- new post-command-chunk")
5164 (setq mumamo-post-command-chunk
5165 (or (unless have-regions (mumamo-get-existing-new-chunk-at (point) nil))
5166 (mumamo-find-chunks (point) "post-command-get-chunk"))))))
5168 ;; (setq mumamo-set-major-mode-delay 10)
5169 (defun mumamo-set-major-post-command ()
5170 "Change major mode if necessary after a command.
5171 If the major mode for chunk at `window-point' differ from current
5172 major mode then change major mode to that for the chunk. If
5173 however `mumamo-set-major-mode-delay' is greater than 0 just
5174 request a change of major mode when Emacs is idle that long.
5176 See the variable above for an explanation why a delay might be
5177 needed \(and is the default)."
5178 ;;(msgtrc "set-major-post-command here")
5179 (let* ((in-pre-hook (memq 'mumamo-set-major-pre-command pre-command-hook))
5180 (ovl (unless in-pre-hook (mumamo-post-command-get-chunk (point))))
5181 (major (when ovl (mumamo-chunk-major-mode ovl)))
5182 (set-it-now (not (or in-pre-hook (mumamo-fun-eq major major-mode)))))
5183 ;;(msgtrc "set-major-post-command ovl=%s, in-pre-hook=%s" ovl in-pre-hook)
5184 (if (not set-it-now)
5185 (unless (mumamo-fun-eq major major-mode)
5186 (when mumamo-idle-set-major-mode-timer
5187 (mumamo-request-idle-set-major-mode)))
5188 (if mumamo-done-first-set-major
5189 (if (<= 0 mumamo-set-major-mode-delay)
5190 ;; Window point has been moved to a new chunk with a new
5191 ;; major mode. Major mode will not be changed directly,
5192 ;; but in an idle timer or in pre-command-hook. To avoid
5193 ;; that the user get the wrong key bindings for the new
5194 ;; chunk fetch the local map directly and apply that.
5195 (let* ((map-rec (assoc major mumamo-major-modes-local-maps))
5196 (map (cdr map-rec)))
5198 (setq map (mumamo-fetch-local-map major)))
5199 (unless (eq map 'no-local-map)
5200 (use-local-map map))
5201 (add-hook 'pre-command-hook 'mumamo-set-major-pre-command nil t)
5202 (mumamo-request-idle-set-major-mode))
5203 (mumamo-set-major major ovl)
5204 (message "Switched to %s" major-mode))
5205 (mumamo-set-major major ovl)))))
5207 (defun mumamo-set-major-pre-command ()
5208 "Change major mode if necessary before a command.
5209 When the key sequence that invoked the command is in current
5210 local map and major mode is not the major mode for the current
5211 mumamo chunk then set major mode to that for the chunk."
5212 (mumamo-condition-case err
5213 ;; First see if we can avoid changing major mode
5214 (if (memq this-command mumamo-safe-commands-in-wrong-major)
5215 (mumamo-request-idle-set-major-mode)
5216 ;;(message "pre point=%s" (point))
5217 (let* ((ovl (mumamo-find-chunks (point) "mumamo-set-major-pre-command"))
5218 (major (mumamo-chunk-major-mode ovl)))
5219 ;;(message "pre point=%s" (point))
5221 (lwarn '(mumamo-set-major-pre-command) :error "major=%s" major)
5222 (when (or (not (mumamo-fun-eq major-mode major))
5223 (not (mumamo-set-major-check-keymap)))
5224 (setq major-mode nil)
5225 (mumamo-set-major major ovl)
5226 ;; Unread the last command key sequence
5227 (setq unread-command-events
5228 (append (listify-key-sequence (this-command-keys-vector))
5229 unread-command-events))
5230 ;; Some commands, like `viper-command-argument' need to
5231 ;; know the last command, so tell them.
5232 (setq this-command (lambda ()
5234 (setq this-command last-command)))))))
5236 (mumamo-display-error 'mumamo-set-major-pre-command
5237 "cb:%s, %s" (current-buffer) (error-message-string err)))))
5239 (defun mumamo-idle-set-major-mode (buffer window)
5240 "Set major mode from mumamo chunk when Emacs is idle.
5241 Do this only if current buffer is BUFFER and then do it in window
5244 See the variable `mumamo-set-major-mode-delay' for an
5246 (save-match-data ;; runs in idle timer
5247 (mumamo-msgfntfy "mumamo-idle-set-major-mode b=%s, window=%s" buffer window)
5248 (with-selected-window window
5249 ;; According to Stefan Monnier we need to set the buffer too.
5250 (with-current-buffer (window-buffer window)
5251 (when (eq buffer (current-buffer))
5252 (mumamo-condition-case err
5253 ;;(let* ((ovl (mumamo-get-chunk-at (point)))
5254 ;;(message "idle point=%s" (point))
5255 (let* ((ovl (mumamo-find-chunks (point) "mumamo-idle-set-major-mode"))
5256 (major (mumamo-chunk-major-mode ovl))
5257 (modified (buffer-modified-p)))
5258 ;;(message "idle point=%s" (point))
5259 (unless (mumamo-fun-eq major major-mode)
5260 ;;(message "mumamo-set-major at A")
5261 (mumamo-set-major major ovl)
5262 ;; Fix-me: This is a bug workaround. Possibly in Emacs.
5263 (when (and (buffer-modified-p)
5265 (set-buffer-modified-p nil))
5267 (when (timerp mumamo-unread-command-events-timer)
5268 (cancel-timer mumamo-unread-command-events-timer))
5269 (when unread-command-events
5270 ;; Save unread keys before calling `top-level' which
5272 (setq mumamo-unread-command-events-timer
5273 (run-with-idle-timer
5275 'mumamo-unread-command-events
5276 unread-command-events
5277 major last-command))
5281 (mumamo-display-error 'mumamo-idle-set-major-mode
5282 "cb=%s, err=%s" (current-buffer) err))))))))
5284 (defun mumamo-post-command-1 (&optional no-debug)
5285 "See `mumamo-post-command'.
5286 Turn on `debug-on-error' unless NO-DEBUG is nil."
5287 (unless no-debug (setq debug-on-error t))
5288 (setq mumamo-find-chunks-level 0)
5289 (mumamo-msgfntfy "mumamo-post-command-1 ENTER: font-lock-mode=%s" font-lock-mode)
5291 (mumamo-set-major-post-command)
5292 ;;(mumamo-on-font-lock-off)
5294 ;;(msgtrc "mumamo-post-command-1 EXIT: font-lock-keywords-only =%s" (default-value 'font-lock-keywords-only))
5300 (defvar mumamo-bug-3467-w14 41)
5301 (defvar mumamo-bug-3467-w15 51)
5302 ;;(mumamo-check-has-bug3467 t)
5303 ;;(kill-local-variable 'mumamo-bug-3467-w14)
5304 (defun mumamo-check-has-bug3467 (verbose)
5305 (let ((has-bug nil))
5307 (let ((mumamo-bug-3467-w14 42)
5308 (mumamo-bug-3467-w15 52))
5309 (when verbose (message "mumamo-bug-3467-w14 maybe let: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w14 (default-value 'mumamo-bug-3467-w14)))
5310 (when verbose (message "mumamo-bug-3467-w15 maybe let: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w15 (default-value 'mumamo-bug-3467-w15)))
5311 (set (make-local-variable 'mumamo-bug-3467-w14) 43)
5312 (set-default 'mumamo-bug-3467-w14 44)
5313 (set-default 'mumamo-bug-3467-w15 54)
5314 (when verbose (message "mumamo-bug-3467-w14 maybe let: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w14 (default-value 'mumamo-bug-3467-w14)))
5315 (when verbose (message "mumamo-bug-3467-w15 maybe let: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w15 (default-value 'mumamo-bug-3467-w15))))
5316 (when verbose (message "mumamo-bug-3467-w14 top level: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w14 (default-value 'mumamo-bug-3467-w14)))
5317 (when (/= mumamo-bug-3467-w14 43) (setq has-bug t))
5318 (when (/= (default-value 'mumamo-bug-3467-w14) 41) (setq has-bug t))
5319 (when verbose (message "mumamo-bug-3467-w15 top level: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w15 (default-value 'mumamo-bug-3467-w15)))
5321 (when verbose (message "mumamo-bug-3467-w14 top level: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w14 (default-value 'mumamo-bug-3467-w14)))
5322 (when verbose (message "mumamo-bug-3467-w15 top level: in buffer %s=%S, global=%S" (current-buffer) mumamo-bug-3467-w15 (default-value 'mumamo-bug-3467-w15)))
5324 (local-variable-p 'mumamo-bug-3467-w14)
5325 (/= (default-value 'mumamo-bug-3467-w14) 41)
5329 (defvar mumamo-has-bug3467 (mumamo-check-has-bug3467 nil))
5331 (defun mumamo-emacs-start-bug3467-timer-if-needed ()
5332 "Work around for Emacs bug 3467. The only one I have found."
5333 (when mumamo-has-bug3467
5334 (run-with-idle-timer 0 nil 'mumamo-emacs-bug3467-workaround)))
5336 (defun mumamo-emacs-bug3467-workaround ()
5337 "Work around for Emacs bug 3467. The only one I have found."
5338 (set-default 'font-lock-keywords-only nil))
5343 (defun mumamo-post-command ()
5344 "Run this in `post-command-hook'.
5345 Change major mode if necessary."
5346 ;;(msgtrc "mumamo-post-command")
5347 (when mumamo-multi-major-mode
5348 (mumamo-condition-case err
5349 (mumamo-post-command-1 t)
5351 (mumamo-msgfntfy "mumamo-post-command %S" err)
5352 ;; Warnings are to disturbing when run in post-command-hook,
5353 ;; but this message is important so show it with an highlight.
5356 "%s\n- Please try M-: (mumamo-post-command-1) to see what happened."
5358 (error-message-string err))))))
5360 (defun mumamo-change-major-function ()
5361 "Function added to `change-major-mode-hook'.
5362 Remove mumamo when changing to a new major mode if the change is
5363 not done because point was to a new chunk."
5364 (unless mumamo-set-major-running
5365 (mumamo-turn-off-actions)))
5367 (defun mumamo-derived-from-mode (major from-mode)
5368 "Return t if major mode MAJOR is derived from FROM-MODE."
5369 (let ((major-mode major))
5370 (derived-mode-p from-mode)))
5372 ;; This is the new version of add-hook. For its origin see
5373 ;; http://lists.gnu.org/archive/html/emacs-devel/2007-12/msg00169.html
5375 ;;(unless (> emacs-major-version 22)
5376 (defvar mumamo-test-add-hook nil
5380 ;;(add-hook 'mumamo-test-add-hook 'mumamo-jit-lock-after-change nil t)
5381 (add-hook 'mumamo-test-add-hook 'mumamo-after-change nil t)
5382 (setq has-it (eq 'permanent-local-hook
5383 (get 'mumamo-test-add-hook 'permanent-local)))
5385 (defun add-hook (hook function &optional append local)
5386 "Add to the value of HOOK the function FUNCTION.
5387 FUNCTION is not added if already present.
5388 FUNCTION is added (if necessary) at the beginning of the hook list
5389 unless the optional argument APPEND is non-nil, in which case
5390 FUNCTION is added at the end.
5392 The optional fourth argument, LOCAL, if non-nil, says to modify
5393 the hook's buffer-local value rather than its default value.
5394 This makes the hook buffer-local if needed, and it makes t a member
5395 of the buffer-local value. That acts as a flag to run the hook
5396 functions in the default value as well as in the local value.
5398 HOOK should be a symbol, and FUNCTION may be any valid function. If
5399 HOOK is void, it is first set to nil. If HOOK's value is a single
5400 function, it is changed to a list of functions."
5401 (or (boundp hook) (set hook nil))
5402 (or (default-boundp hook) (set-default hook nil))
5403 (if local (unless (local-variable-if-set-p hook)
5404 (set (make-local-variable hook) (list t)))
5405 ;; Detect the case where make-local-variable was used on a hook
5406 ;; and do what we used to do.
5407 (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook)))
5409 (let ((hook-value (if local (symbol-value hook) (default-value hook))))
5410 ;; If the hook value is a single function, turn it into a list.
5411 (when (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
5412 (setq hook-value (list hook-value)))
5413 ;; Do the actual addition if necessary
5414 (unless (member function hook-value)
5417 (append hook-value (list function))
5418 (cons function hook-value))))
5419 ;; Set the actual variable
5422 ;; If HOOK isn't a permanent local,
5423 ;; but FUNCTION wants to survive a change of modes,
5424 ;; mark HOOK as partially permanent.
5425 (and (symbolp function)
5426 (get function 'permanent-local-hook)
5427 (not (get hook 'permanent-local))
5428 (put hook 'permanent-local 'permanent-local-hook))
5429 (set hook hook-value))
5430 (set-default hook hook-value))))
5434 (defvar mumamo-survive-hooks
5436 ;; activate-mark-hook after-change-functions after-save-hook
5437 ;; before-save-functions auto-save-hook before-revert-hook
5438 ;; buffer-access-fontify-functions calendar-load-hook
5439 ;; command-line-functions compilation-finish-function
5440 ;; deactivate-mark-hook find-file-hook
5441 ;; find-file-not-found-functions first-change-hook
5442 ;; kbd-macro-termination-hook kill-buffer-hook
5443 ;; kill-buffer-query-functions menu-bar-update-hook
5444 ;; post-command-hook pre-abbrev-expand-hook pre-command-hook
5445 ;; write-contents-functions write-file-functions
5446 ;; write-region-annotate-functions
5447 ;; c-special-indent-hook
5453 ;; These variables should have 'permanant-local t set in their
5454 ;; packages IMO, but now they do not have that.
5455 (eval-after-load 'viper-cmd
5457 (put 'viper-after-change-functions 'permanent-local t)
5458 (put 'viper-before-change-functions 'permanent-local t)
5460 (eval-after-load 'viper
5462 (put 'viper-post-command-hooks 'permanent-local t)
5463 (put 'viper-pre-command-hooks 'permanent-local t)
5464 ;;minor-mode-map-alist
5465 ;; viper-mode-string -- is already buffer local, globally void
5466 (put 'viper-mode-string 'permanent-local t)
5469 (eval-after-load 'viper-init
5471 (put 'viper-d-com 'permanent-local t)
5472 (put 'viper-last-insertion 'permanent-local t)
5473 (put 'viper-command-ring 'permanent-local t)
5474 (put 'viper-vi-intercept-minor-mode 'permanent-local t)
5475 (put 'viper-vi-basic-minor-mode 'permanent-local t)
5476 (put 'viper-vi-local-user-minor-mode 'permanent-local t)
5477 (put 'viper-vi-global-user-minor-mode 'permanent-local t)
5478 (put 'viper-vi-state-modifier-minor-mode 'permanent-local t)
5479 (put 'viper-vi-diehard-minor-mode 'permanent-local t)
5480 (put 'viper-vi-kbd-minor-mode 'permanent-local t)
5481 (put 'viper-insert-intercept-minor-mode 'permanent-local t)
5482 (put 'viper-insert-basic-minor-mode 'permanent-local t)
5483 (put 'viper-insert-local-user-minor-mode 'permanent-local t)
5484 (put 'viper-insert-global-user-minor-mode 'permanent-local t)
5485 (put 'viper-insert-state-modifier-minor-mode 'permanent-local t)
5486 (put 'viper-insert-diehard-minor-mode 'permanent-local t)
5487 (put 'viper-insert-kbd-minor-mode 'permanent-local t)
5488 (put 'viper-replace-minor-mode 'permanent-local t)
5489 (put 'viper-emacs-intercept-minor-mode 'permanent-local t)
5490 (put 'viper-emacs-local-user-minor-mode 'permanent-local t)
5491 (put 'viper-emacs-global-user-minor-mode 'permanent-local t)
5492 (put 'viper-emacs-kbd-minor-mode 'permanent-local t)
5493 (put 'viper-emacs-state-modifier-minor-mode 'permanent-local t)
5494 (put 'viper-vi-minibuffer-minor-mode 'permanent-local t)
5495 (put 'viper-insert-minibuffer-minor-mode 'permanent-local t)
5496 (put 'viper-automatic-iso-accents 'permanent-local t)
5497 (put 'viper-special-input-method 'permanent-local t)
5498 (put 'viper-intermediate-command 'permanent-local t)
5499 ;; already local: viper-undo-needs-adjustment
5500 (put 'viper-began-as-replace 'permanent-local t)
5501 ;; already local: viper-replace-overlay
5502 ;; already local: viper-last-posn-in-replace-region
5503 ;; already local: viper-last-posn-while-in-insert-state
5504 ;; already local: viper-sitting-in-replace
5505 (put 'viper-replace-chars-to-delete 'permanent-local t)
5506 (put 'viper-replace-region-chars-deleted 'permanent-local t)
5507 (put 'viper-current-state 'permanent-local t)
5508 (put 'viper-cted 'permanent-local t)
5509 (put 'viper-current-indent 'permanent-local t)
5510 (put 'viper-preserve-indent 'permanent-local t)
5511 (put 'viper-auto-indent 'permanent-local t)
5512 (put 'viper-electric-mode 'permanent-local t)
5513 ;; already local: viper-insert-point
5514 ;; already local: viper-pre-command-point
5515 (put 'viper-com-point 'permanent-local t)
5516 (put 'viper-ex-style-motion 'permanent-local t)
5517 (put 'viper-ex-style-editing 'permanent-local t)
5518 (put 'viper-ESC-moves-cursor-back 'permanent-local t)
5519 (put 'viper-delete-backwards-in-replace 'permanent-local t)
5520 ;; already local: viper-related-files-and-buffers-ring
5521 (put 'viper-local-search-start-marker 'permanent-local t)
5522 (put 'viper-search-overlay 'permanent-local t)
5523 (put 'viper-last-jump 'permanent-local t)
5524 (put 'viper-last-jump-ignore 'permanent-local t)
5525 (put 'viper-minibuffer-current-face 'permanent-local t)
5526 ;; already local: viper-minibuffer-overlay
5527 (put 'viper-command-ring 'permanent-local t)
5528 (put 'viper-last-insertion 'permanent-local t)
5530 (eval-after-load 'viper-keym
5532 ;; already local: viper-vi-local-user-map
5533 ;; already local: viper-insert-local-user-map
5534 ;; already local: viper-emacs-local-user-map
5535 (put 'viper--key-maps 'permanent-local t)
5536 (put 'viper--intercept-key-maps 'permanent-local t)
5537 ;; already local: viper-need-new-vi-local-map
5538 ;; already local: viper-need-new-insert-local-map
5539 ;; already local: viper-need-new-emacs-local-map
5541 (eval-after-load 'viper-mous
5543 (put 'viper-mouse-click-search-noerror 'permanent-local t)
5544 (put 'viper-mouse-click-search-limit 'permanent-local t)
5546 (eval-after-load 'viper-util
5548 (put 'viper-syntax-preference 'permanent-local t)
5549 (put 'viper-non-word-characters 'permanent-local t)
5550 (put 'viper-ALPHA-char-class 'permanent-local t)
5553 (eval-after-load 'cua-base
5555 (put 'cua-inhibit-cua-keys 'permanent-local t)
5556 (put 'cua--explicit-region-start 'permanent-local t)
5557 (put 'cua--status-string 'permanent-local t)
5559 ;; This is for the defvar in ido.el:
5560 (eval-after-load 'ido
5562 (put 'cua-inhibit-cua-keys 'permanent-local t)
5564 (eval-after-load 'cua-rect
5566 (put 'cua--rectangle 'permanent-local t)
5567 (put 'cua--rectangle-overlays 'permanent-local t)
5569 (eval-after-load 'edt
5571 (put 'edt-select-mode 'permanent-local t)
5573 (eval-after-load 'tpu-edt
5575 (put 'tpu-newline-and-indent-p 'permanent-local t)
5576 (put 'tpu-newline-and-indent-string 'permanent-local t)
5577 (put 'tpu-saved-delete-func 'permanent-local t)
5578 (put 'tpu-buffer-local-map 'permanent-local t)
5579 (put 'tpu-mark-flag 'permanent-local t)
5581 (eval-after-load 'vi
5583 (put 'vi-add-to-mode-line 'permanent-local t)
5584 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-scroll-amount
5585 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-shift-width
5586 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-point
5587 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-length
5588 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-repetition
5589 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-overwrt-p
5590 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-prefix-code
5591 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-last-change-command
5592 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-last-shell-command
5593 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-last-find-char
5594 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mark-alist
5595 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-insert-state
5596 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mode-old-local-map
5597 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mode-old-mode-name
5598 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mode-old-major-mode
5599 ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mode-old-case-fold
5602 (eval-after-load 'vi
5604 (put 'vip-emacs-local-map 'permanent-local t)
5605 (put 'vip-insert-local-map 'permanent-local t)
5606 (put 'vip-insert-point 'permanent-local t)
5607 (put 'vip-com-point 'permanent-local t)
5608 (put 'vip-current-mode 'permanent-local t)
5609 (put 'vip-emacs-mode-line-buffer-identification 'permanent-local t)
5610 (put 'vip-current-major-mode 'permanent-local t)
5613 (eval-after-load 'hi-lock
5615 (put 'hi-lock-mode 'permanent-local t)
5619 ;; Minor modes that are not major mode specific
5622 (put 'visual-line-mode 'permanent-local t)
5624 (eval-after-load 'flymake
5627 (put 'flymake-after-change-function 'permanent-local-hook t)
5628 (put 'flymake-after-save-hook 'permanent-local-hook t)
5629 (put 'flymake-kill-buffer-hook 'permanent-local-hook t)
5631 ;;; (put 'after-change-functions 'permanent-local 'permanent-local-hook)
5632 ;;; (put 'after-save-hook 'permanent-local 'permanent-local-hook)
5633 ;;; (put 'kill-buffer-hook 'permanent-local 'permanent-local-hook)
5635 (put 'flymake-mode 'permanent-local t)
5636 (put 'flymake-is-running 'permanent-local t)
5637 (put 'flymake-timer 'permanent-local t)
5638 (put 'flymake-last-change-time 'permanent-local t)
5639 (put 'flymake-check-start-time 'permanent-local t)
5640 (put 'flymake-check-was-interrupted 'permanent-local t)
5641 (put 'flymake-err-info 'permanent-local t)
5642 (put 'flymake-new-err-info 'permanent-local t)
5643 (put 'flymake-output-residual 'permanent-local t)
5644 (put 'flymake-mode-line 'permanent-local t)
5645 (put 'flymake-mode-line-e-w 'permanent-local t)
5646 (put 'flymake-mode-line-status 'permanent-local t)
5647 (put 'flymake-temp-source-file-name 'permanent-local t)
5648 (put 'flymake-master-file-name 'permanent-local t)
5649 (put 'flymake-temp-master-file-name 'permanent-local t)
5650 (put 'flymake-base-dir 'permanent-local t)))
5652 ;; (eval-after-load 'imenu
5654 ;; ;; Fix-me: imenu is only useful for main major mode. The menu
5655 ;; ;; disappears in sub chunks because it is tighed to
5656 ;; ;; local-map. Don't know what to do about that. I do not
5657 ;; ;; understand the reason for binding it to local-map, but I
5658 ;; ;; suspect the intent is to have different menu items for
5659 ;; ;; different modes. Could not that be achieved by deleting the
5660 ;; ;; menu and creating it again when changing major mode? (That must
5661 ;; ;; be implemented in imenu.el of course.)
5663 ;; ;; hook functions:
5664 ;; ;;; (put 'imenu-update-menubar 'permanent-local-hook t)
5666 ;; (put 'menu-bar-update-hook 'permanent-local 'permanent-local-hook)
5668 ;; (put 'imenu-generic-expression 'permanent-local t)
5669 ;; (put 'imenu-create-index-function 'permanent-local t)
5670 ;; (put 'imenu-prev-index-position-function 'permanent-local t)
5671 ;; (put 'imenu-extract-index-name-function 'permanent-local t)
5672 ;; (put 'imenu-name-lookup-function 'permanent-local t)
5673 ;; (put 'imenu-default-goto-function 'permanent-local t)
5674 ;; (put 'imenu--index-alist 'permanent-local t)
5675 ;; (put 'imenu--last-menubar-index-alist 'permanent-local t)
5676 ;; (put 'imenu-syntax-alist 'permanent-local t)
5677 ;; (put 'imenu-case-fold-search 'permanent-local t)
5678 ;; (put 'imenu-menubar-modified-tick 'permanent-local t)
5681 (eval-after-load 'longlines
5683 ;; Fix-me: take care of longlines-mode-off
5684 (put 'longlines-mode 'permanent-local t)
5685 (put 'longlines-wrap-beg 'permanent-local t)
5686 (put 'longlines-wrap-end 'permanent-local t)
5687 (put 'longlines-wrap-point 'permanent-local t)
5688 (put 'longlines-showing 'permanent-local t)
5689 (put 'longlines-decoded 'permanent-local t)
5691 (put 'longlines-after-change-function 'permanent-local-hook t)
5692 (put 'longlines-after-revert-hook 'permanent-local-hook t)
5693 (put 'longlines-before-revert-hook 'permanent-local-hook t)
5694 (put 'longlines-decode-buffer 'permanent-local-hook t)
5695 (put 'longlines-decode-region 'permanent-local-hook t)
5696 (put 'longlines-mode-off 'permanent-local-hook t)
5697 (put 'longlines-post-command-function 'permanent-local-hook t)
5698 (put 'longlines-window-change-function 'permanent-local-hook t)
5699 ;;(put 'mail-indent-citation 'permanent-local-hook t)
5703 ;; Fix-me: Rails, many problematic things:
5705 ;;; Fix-me: No idea about these, where are they used?? Add them to
5706 ;;; mumamo-per-buffer-local-vars?:
5707 ;; predictive-main-dict
5708 ;; predictive-prog-mode-main-dict
5709 ;; predictive-use-auto-learn-cache
5710 ;; predictive-dict-autosave-on-kill-buffer
5711 (eval-after-load 'inf-ruby
5713 (put 'inferior-ruby-first-prompt-pattern 'permanent-local t)
5714 (put 'inferior-ruby-prompt-pattern 'permanent-local t)
5717 ;;; These are for the output buffer (no problems):
5718 ;; font-lock-keywords-only
5719 ;; font-lock-defaults -- always buffer local
5721 ;; scroll-preserve-screen-position
5723 (eval-after-load 'rails-script
5725 (put 'rails-script:run-after-stop-hook 'permanent-local t)
5726 (put 'rails-script:show-buffer-hook 'permanent-local t)
5727 (put 'rails-script:output-mode-ret-value 'permanent-local t)
5730 ;;; No problems I believe (it is in output buffer):
5731 ;; compilation-error-regexp-alist-alist
5732 ;; compilation-error-regexp-alist
5734 ;;; Fix-me: This is in the minor mode, what to do? Looks like it
5735 ;;; should have 'permanent-local t - in this case. I have added it to
5736 ;;; mumamo-per-buffer-local-vars for now.
5739 (eval-after-load 'rails
5741 (put 'rails-primary-switch-func 'permanent-local t)
5742 (put 'rails-secondary-switch-func 'permanent-local t)
5745 ;; (defun test-js-perm ()
5746 ;; (put 'js--quick-match-re 'permanent-local t)
5747 ;; (put 'js--quick-match-re-func 'permanent-local t)
5748 ;; (put 'js--cache-end 'permanent-local t)
5749 ;; (put 'js--last-parse-pos 'permanent-local t)
5750 ;; (put 'js--state-at-last-parse-pos 'permanent-local t)
5751 ;; (put 'js--tmp-location 'permanent-local t))
5754 (defvar mumamo-per-buffer-local-vars
5759 ;; Fix-me: This is to prevent font-lock-mode turning off/on, but
5761 ;;font-lock-mode-major-mode
5764 ;; Fix-me: adding rng timers here stops Emacs from looping after
5765 ;; indenting in ind-0-error.php, but I have no clue why. Hm. This
5766 ;; problem is gone, but I forgot why.
5767 rng-c-current-token ;;rng-cmpct.el:132:(make-variable-buffer-local 'rng-c-current-token)
5768 rng-c-escape-positions ;;rng-cmpct.el:341:(make-variable-buffer-local 'rng-c-escape-positions)
5769 rng-c-file-name ;;rng-cmpct.el:344:(make-variable-buffer-local 'rng-c-file-name)
5770 rng-current-schema-file-name ;;rng-loc.el:37:(make-variable-buffer-local 'rng-current-schema-file-name)
5771 rng-current-schema ;;rng-pttrn.el:71:(make-variable-buffer-local 'rng-current-schema)
5772 ;;rng-validate-timer is permanent-local t
5773 ;;rng-validate-timer ;;rng-valid.el:141:(make-variable-buffer-local 'rng-validate-timer)
5774 ;;rng-validate-quick-timer is permanent-local t
5775 ;;rng-validate-quick-timer ;;rng-valid.el:146:(make-variable-buffer-local 'rng-validate-quick-timer)
5776 rng-error-count ;;rng-valid.el:153:(make-variable-buffer-local 'rng-error-count)
5777 rng-message-overlay ;;rng-valid.el:158:(make-variable-buffer-local 'rng-message-overlay)
5778 rng-message-overlay-inhibit-point ;;rng-valid.el:165:(make-variable-buffer-local 'rng-message-overlay-inhibit-point)
5779 rng-message-overlay-current ;;rng-valid.el:169:(make-variable-buffer-local 'rng-message-overlay-current)
5780 rng-validate-up-to-date-end ;;rng-valid.el:188:(make-variable-buffer-local 'rng-validate-up-to-date-end)
5781 rng-conditional-up-to-date-start ;;rng-valid.el:199:(make-variable-buffer-local 'rng-conditional-up-to-date-start)
5782 rng-conditional-up-to-date-end ;;rng-valid.el:205:(make-variable-buffer-local 'rng-conditional-up-to-date-end)
5783 rng-validate-mode ;;rng-valid.el:212:(make-variable-buffer-local 'rng-validate-mode)
5784 rng-dtd ;;rng-valid.el:215:(make-variable-buffer-local 'rng-dtd)
5786 nxml-syntax-highlight-flag ;; For pre-Emacs nxml
5787 ;;nxml-ns-state - not buffer local currently
5788 nxml-prolog-regions ;;snxml-mode.el:362:(make-variable-buffer-local 'nxml-prolog-regions)
5789 nxml-last-fontify-end ;;dnxml-mode.el:367:(make-variable-buffer-local 'nxml-last-fontify-end)
5790 nxml-degraded ;;dnxml-mode.el:373:(make-variable-buffer-local 'nxml-degraded)
5791 nxml-char-ref-extra-display ;;ynxml-mode.el:397:(make-variable-buffer-local 'nxml-char-ref-extra-display)
5792 nxml-prolog-end ;;dnxml-rap.el:92:(make-variable-buffer-local 'nxml-prolog-end)
5793 nxml-scan-end ;;dnxml-rap.el:107:(make-variable-buffer-local 'nxml-scan-end)
5795 ;;buffer-invisibility-spec
5796 ;;header-line-format
5798 ;; Fix-me: These must be handled with 'permanent-local since they may be changed:
5799 line-move-visual ;;simple.el:4537: (kill-local-variable 'line-move-visual)
5800 word-wrap ;;simple.el:4538: (kill-local-variable 'word-wrap)
5801 truncate-lines ;;simple.el:4539: (kill-local-variable 'truncate-lines)
5802 truncate-partial-width-windows ;;simple.el:4540: (kill-local-variable 'truncate-partial-width-windows)
5803 fringe-indicator-alist ;;simple.el:4541: (kill-local-variable 'fringe-indicator-alist)
5804 visual-line--saved-state ;;simple.el:4544: (kill-local-variable 'visual-line--saved-state)))
5805 vis-mode-saved-buffer-invisibility-spec ;;simple.el:6237: (kill-local-variable 'vis-mode-saved-buffer-invisibility-spec))
5808 "Per buffer local variables.
5809 See also `mumamo-per-main-major-local-vars'.")
5811 ;; Fix-me: use this, but how exactly? I think the var values must be
5812 ;; picked up at every change from main major mode. And restored after
5813 ;; changing to the new major mode - but maybe a bit differently if
5814 ;; this is the main major mode.
5815 (defvar mumamo-per-main-major-local-vars
5817 buffer-invisibility-spec
5820 "Per main major local variables.
5821 Like `mumamo-per-buffer-local-vars', but this is fetched from the
5825 ;; (make-variable-buffer-local 'mumamo-survive-minor-modes)
5826 ;; (put 'mumamo-survive-minor-modes 'permanent-local t)
5827 ;; (defvar mumamo-survive-minor-modes nil
5828 ;; "Hold local minor mode variables specific major modes.
5829 ;; Those values are saved when leaving a chunk with a certain
5830 ;; major mode and restored when entering a chunk with the same
5831 ;; major mode again.
5833 ;; The value of this variable is an associative list where the key
5836 ;; \(MAJOR-MODE MINOR-MODE)
5838 ;; and the value is a stored value for the minor mode.")
5841 (defun mumamo-make-variable-buffer-permanent (var)
5842 "Make buffer local value of VAR survive when moving point to a new chunk.
5843 When point is moved between chunks in a multi major mode the
5844 major mode will be changed. This will by default kill all local
5845 variables unless they have a non-nil `permanent-local' property
5846 \(see info node `(elisp)Creating Buffer-Local').
5848 If you do not want to put a `permanent-local' property on a
5849 variable you can instead use this function to make variable VAR
5850 survive chunk switches in all mumamo multi major mode buffers."
5851 ;; If you want it to survive chunk switches only in the current
5852 ;; buffer then use `mumamo-make-local-permanent' instead."
5853 (pushnew var (default-value 'mumamo-per-buffer-local-vars)))
5855 ;; ;; Fix-me: use local value
5856 ;; ;; Fix-me: delelete local value when exiting mumamo
5857 ;; (defun mumamo-make-local-permanent (var)
5858 ;; "Make buffer local value of VAR survive when moving point to a new chunk.
5859 ;; This is for the current buffer only.
5860 ;; In most cases you almost certainly want to use
5861 ;; `mumamo-make-variable-buffer-permanent' instead."
5862 ;; (pushnew var mumamo-per-buffer-local-vars))
5864 (defvar mumamo-per-buffer-local-vars-done-by-me nil
5865 "Variables set by mumamo already.
5866 Used to avoid unnecessary warnings if setting major mode fails.")
5868 ;; (mumamo-hook-p 'viper-pre-command-hooks)
5869 ;; (mumamo-hook-p 'viper-before-change-functions)
5870 ;; (mumamo-hook-p 'c-special-indent-hook)
5871 (defun mumamo-hook-p (sym)
5872 "Try to detect if SYM is a hook variable.
5873 Just check the name."
5874 (let ((name (symbol-name sym)))
5875 (or (string= "-hook" (substring name -5))
5876 (string= "-hooks" (substring name -6))
5877 (string= "-functions" (substring name -10)))))
5879 (defvar mumamo-major-mode nil)
5880 (make-variable-buffer-local 'mumamo-major-mode)
5881 (put 'mumamo-major-mode 'permanent-local t)
5883 (defvar mumamo-change-major-mode-no-nos
5884 '((font-lock-change-mode t)
5885 (longlines-mode-off t)
5886 global-font-lock-mode-cmhh
5888 (turn-off-hideshow t))
5889 "Avoid running these in `change-major-mode-hook'.")
5892 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5893 ;;;; Remove things from hooks temporarily
5895 ;; Fix-me: This is a bit disorganized, could not decide which level I
5898 (defvar mumamo-after-change-major-mode-no-nos
5899 '(;;nxhtml-global-minor-mode-enable-in-buffers
5900 global-font-lock-mode-enable-in-buffers)
5901 "Avoid running these in `after-change-major-mode-hook'.")
5903 (defvar mumamo-removed-from-hook nil)
5905 (defun mumamo-remove-from-hook (hook remove)
5906 "From hook HOOK remove functions in list REMOVE.
5907 Save HOOK and the list of functions removed to
5908 `mumamo-removed-from-hook'."
5911 (dolist (rem remove)
5912 ;;(message "rem.rem=%s" rem)
5913 (setq did-remove nil)
5915 (when (memq (car rem) (symbol-value hook))
5917 (remove-hook hook (car rem) t))
5918 (when (memq rem (symbol-value hook))
5920 (remove-hook hook rem)))
5922 (setq removed (cons rem removed))))
5923 (setq mumamo-removed-from-hook
5924 (cons (cons hook removed)
5925 mumamo-removed-from-hook))))
5927 (defun mumamo-addback-to-hooks ()
5928 "Add back what was removed by `mumamo-remove-from-hook'."
5929 ;;(message "mumamo-removed-from-hook=%s" mumamo-removed-from-hook)
5930 (dolist (rem-rec mumamo-removed-from-hook)
5931 (mumamo-addback-to-hook (car rem-rec) (cdr rem-rec))))
5933 (defun mumamo-addback-to-hook (hook removed)
5934 "Add to hook HOOK the list of functions in REMOVED."
5935 ;;(message "addback: hook=%s, removed=%s" hook removed)
5936 (dolist (rem removed)
5937 ;;(message "add.rem=%s" rem)
5939 (add-hook hook (car rem) nil t)
5940 (add-hook hook rem))))
5941 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
5943 ;; Compare mumamo-irrelevant-buffer-local-vars
5944 (defvar mumamo-buffer-locals-dont-set
5947 adaptive-fill-first-line-regexp
5948 adaptive-fill-regexp
5949 add-log-current-defun-header-regexp
5950 auto-composition-function
5951 auto-composition-mode
5952 auto-composition-mode-major-mode
5955 beginning-of-defun-function
5956 buffer-auto-save-file-format
5957 buffer-auto-save-file-name
5959 buffer-display-count
5961 buffer-file-coding-system
5964 buffer-file-truename
5965 buffer-invisibility-spec
5970 c++-template-syntax-table
5972 c-<>-multichar-token-regexp
5974 c-after-suffixed-type-decl-key
5975 c-after-suffixed-type-maybe-decl-key
5976 c-anchored-cpp-prefix
5977 c-assignment-op-regexp
5980 c-backslash-max-column
5982 c-before-font-lock-function
5983 c-block-comment-prefix
5984 c-block-comment-start-regexp
5985 c-block-prefix-charset
5992 c-colon-type-list-re
5993 c-comment-only-line-offset
5994 c-comment-prefix-regexp
5995 c-comment-start-regexp
5996 c-current-comment-prefix
5999 c-decl-prefix-or-start-re
6002 c-doc-comment-start-regexp
6005 c-get-state-before-change-function
6006 c-hanging-braces-alist
6007 c-hanging-colons-alist
6008 c-hanging-semi&comma-criteria
6011 c-identifier-syntax-modifications
6012 c-identifier-syntax-table
6013 ;;c-indent-comment-alist
6014 ;;c-indent-comments-syntactically-p
6015 ;;c-indentation-style
6020 c-label-minimum-indentation
6022 c-line-comment-starter
6023 c-literal-start-regexp
6024 c-multiline-string-start-char
6025 c-nonlabel-token-key
6027 c-nonsymbol-token-regexp
6028 c-not-decl-init-keywords
6032 c-opt-<>-arglist-start
6033 c-opt-<>-arglist-start-in-paren
6037 c-opt-block-decls-with-vars-key
6038 c-opt-block-stmt-key
6039 c-opt-cpp-macro-define-id
6040 c-opt-cpp-macro-define-start
6043 c-opt-extra-label-key
6045 c-opt-identifier-concat-key
6046 c-opt-inexpr-brace-list-key
6048 c-opt-op-identifier-prefix
6049 c-opt-postfix-decl-spec-key
6050 c-opt-type-component-key
6051 c-opt-type-concat-key
6052 c-opt-type-modifier-key
6053 c-opt-type-suffix-key
6054 c-other-decl-block-key
6055 c-other-decl-block-key-in-symbols-alist
6056 c-overloadable-operators-regexp
6057 c-paragraph-separate
6060 c-prefix-spec-kwds-re
6061 c-primary-expr-regexp
6062 c-primitive-type-key
6063 c-recognize-<>-arglists
6064 c-recognize-colon-labels
6066 c-recognize-paren-inexpr-blocks
6067 c-recognize-paren-inits
6068 c-recognize-typeless-decls
6069 c-regular-keywords-regexp
6071 c-special-brace-lists
6072 c-special-indent-hook
6075 c-stmt-delim-chars-with-comma
6076 c-string-escaped-newlines
6081 c-syntactic-ws-start
6082 c-type-decl-end-used
6083 c-type-decl-prefix-key
6084 c-type-decl-suffix-key
6086 c-vsemi-status-unknown-p-fn
6091 comment-indent-function
6092 comment-line-break-function
6102 enable-multibyte-characters
6103 end-of-defun-function
6105 fill-paragraph-function
6106 font-lock-beginning-of-syntax-function
6108 font-lock-extend-after-change-region-function
6109 font-lock-extend-region-functions
6111 font-lock-fontify-buffer-function
6112 font-lock-fontify-region-function
6114 ;;font-lock-keywords-only
6115 font-lock-keywords-case-fold-search
6118 font-lock-mode-major-mode
6120 font-lock-set-defaults
6121 font-lock-syntactic-keywords
6122 font-lock-syntactically-fontified
6123 font-lock-syntax-table
6124 font-lock-unfontify-buffer-function
6125 font-lock-unfontify-region-function
6126 fontification-functions
6127 forward-sexp-function
6129 indent-line-function
6130 indent-region-function
6132 imenu--last-menubar-index-alist
6133 imenu-create-index-function
6134 imenu-menubar-modified-tick
6137 jit-lock-after-change-extend-region-functions
6138 jit-lock-context-unfontify-pos
6139 jit-lock-contextually
6143 line-move-ignore-invisible
6152 normal-auto-fill-function
6153 ;;nxhtml-menu-mode-major-mode
6155 open-paren-in-column-0-is-defun-start
6159 paragraph-ignore-fill-prefix
6162 parse-sexp-ignore-comments
6163 parse-sexp-lookup-properties
6167 ;; More symbols from visual inspection
6168 ;;before-change-functions
6169 ;;delayed-mode-hooks
6170 ;;imenu-case-fold-search
6171 ;;imenu-generic-expression
6172 rngalt-completing-read-tag
6173 rngalt-completing-read-attribute-name
6174 rngalt-completing-read-attribute-value
6175 rngalt-complete-first-try
6176 rngalt-complete-last-try
6177 rngalt-complete-tag-hooks
6179 syntax-begin-function
6181 "Buffer local variables that is not saved/set per chunk.
6182 This is supposed to contain mostly buffer local variables
6183 specific to major modes and that are not meant to be customized
6187 (when (< emacs-major-version 23)
6188 (defadvice c-after-change (around
6189 mumamo-ad-c-after-change
6193 ;;(msgtrc "c-after-change: major-mode=%s c-nonsymbol-token-regexp=%s" major-mode c-nonsymbol-token-regexp)
6194 (when (or (not mumamo-multi-major-mode)
6195 (derived-mode-p 'c-mode))
6199 (defun mumamo-save-per-major-local-vars (major)
6200 "Save some per major local variables for major mode MAJOR.
6201 This should be called before switching to a new chunks major
6203 ;;(message "mumamo-save-per-major-local-vars %s %s" major (current-buffer))
6204 (let ((locals (buffer-local-variables)))
6205 (setq locals (mapcar (lambda (local)
6207 (or (memq (car local) mumamo-buffer-locals-dont-set)
6208 (memq (car local) mumamo-per-buffer-local-vars)
6209 (memq (car local) mumamo-per-main-major-local-vars)
6210 (get (car local) 'permanent-local))
6213 (setq locals (delq nil locals))
6214 (setq locals (sort locals (lambda (sym-a sym-b)
6215 (string< (symbol-name (car sym-a))
6216 (symbol-name (car sym-b))))))
6217 (setq mumamo-buffer-locals-per-major
6218 (assq-delete-all major mumamo-buffer-locals-per-major))
6219 (setq mumamo-buffer-locals-per-major
6220 (cons (cons major-mode locals)
6221 mumamo-buffer-locals-per-major))))
6223 ;; (benchmark 1000 '(mumamo-save-per-major-local-vars major-mode))
6224 ;; (benchmark 1000 '(mumamo-restore-per-major-local-vars major-mode))
6225 (defvar mumamo-restore-per-major-local-vars-in-hook-major nil)
6226 (defun mumamo-restore-per-major-local-vars-in-hook ()
6227 "Restore some per major mode local variables.
6228 Call `mumamo-restore-per-major-local-vars'.
6229 Use `mumamo-restore-per-major-local-vars-in-hook-major' as the
6232 This should be called in the major mode setup hook."
6233 (mumamo-restore-per-major-local-vars
6234 mumamo-restore-per-major-local-vars-in-hook-major)
6235 (setq mumamo-restore-per-major-local-vars-in-hook-major nil))
6236 (put 'mumamo-restore-per-major-local-vars-in-hook 'permanent-local-hook t)
6238 (defun mumamo-restore-per-major-local-vars (major)
6239 "Restore some per major local variables for major mode MAJOR.
6240 This should be called after switching to a new chunks major
6242 (let ((locals (cdr (assq major mumamo-buffer-locals-per-major)))
6245 (dolist (rec locals)
6246 (setq var (car rec))
6247 (setq perm (get var 'permanent-local))
6249 (memq var mumamo-buffer-locals-dont-set))
6250 (set (make-local-variable var) (cdr rec))))))
6252 ;; (defun mumamo-testing-new ()
6253 ;; (let ((locals (buffer-local-variables))
6257 ;; (dolist (rec locals)
6258 ;; (setq var (car rec))
6259 ;; (setq perm (get var 'permanent-local))
6261 ;; (memq var mumamo-buffer-locals-dont-set))
6262 ;; (setq var (cdr rec))))
6264 ;; ;;(benchmark 1000 '(mumamo-testing-new))
6266 (defun mumamo-get-hook-value (hook remove)
6267 "Return hook HOOK value with entries in REMOVE removed.
6268 Remove also t. The value returned is a list of both local and
6270 (let ((value (append (symbol-value hook) (default-value hook) nil)))
6271 (dolist (rem remove)
6272 (setq value (delq rem value)))
6275 ;; FIX-ME: Clean up the different ways of surviving variables during
6276 ;; change of major mode.
6277 (defvar mumamo-set-major-keymap-checked nil)
6278 (make-variable-buffer-local 'mumamo-set-major-keymap-checked)
6280 (defvar mumamo-org-startup-done nil)
6281 (make-variable-buffer-local 'mumamo-org-startup-done)
6282 (put 'mumamo-org-startup-done 'permanent-local t)
6285 (defun mumamo-font-lock-fontify-chunk ()
6286 "Like `font-lock-default-fontify-buffer' but for a chunk.
6287 Buffer must be narrowed to inner part of chunk when this function
6289 (let ((verbose (if (numberp font-lock-verbose)
6290 (and (> font-lock-verbose 0)
6291 (> (- (point-max) (point-min)) font-lock-verbose))
6293 font-lock-extend-region-functions ;; accept narrowing
6294 (font-lock-unfontify-region-function 'ignore))
6298 (format "Fontifying %s part %s-%s (%s)..." (buffer-name) (point-min) (point-max) font-lock-verbose))
6302 (font-lock-fontify-region (point-min) (point-max) verbose)
6303 (font-lock-after-fontify-buffer)
6304 (setq font-lock-fontified t)))
6305 (msgtrc "font-lock-fontify-chunk: %s" (error-message-string err))
6306 ;; We don't restore the old fontification, so it's best to unfontify.
6307 (quit (mumamo-font-lock-unfontify-chunk))))))
6310 (defun mumamo-font-lock-unfontify-chunk ()
6311 "Like `font-lock-default-unfontify-buffer' for .
6312 Buffer must be narrowed to chunk when this function is called."
6313 ;; Make sure we unfontify etc. in the whole buffer.
6316 (font-lock-unfontify-region (point-min) (point-max))
6317 (font-lock-after-unfontify-buffer)
6318 (setq font-lock-fontified nil)))
6320 (defun mumamo-set-major (major chunk)
6321 "Set major mode to MAJOR for mumamo."
6322 (mumamo-msgfntfy "mumamo-set-major %s, %s" major (current-buffer))
6323 (mumamo-cancel-idle-set-major-mode)
6324 (remove-hook 'pre-command-hook 'mumamo-set-major-pre-command t)
6325 ;;(mumamo-backtrace "mumamo-set-major")
6326 (remove-hook 'text-mode-hook 'viper-mode) ;; Fix-me: maybe add it back...
6327 (let ((start-time (get-internal-run-time))
6331 viper-vi-state-mode-list
6332 viper-emacs-state-mode-list
6333 viper-insert-state-mode-list
6335 (org-inhibit-startup mumamo-org-startup-done)
6336 ;; Tell `mumamo-change-major-function':
6337 (mumamo-set-major-running major)
6338 ;; Fix-me: Take care of the new values added to these hooks!
6339 ;; That looks difficult. We may after this have changes to
6340 ;; both buffer local value and global value. The global
6341 ;; changes are in this variable, but the buffer local values
6342 ;; have been set once again.
6343 (change-major-mode-hook (mumamo-get-hook-value
6344 'change-major-mode-hook
6345 mumamo-change-major-mode-no-nos))
6346 (after-change-major-mode-hook (mumamo-get-hook-value
6347 'after-change-major-mode-hook
6348 mumamo-after-change-major-mode-no-nos))
6349 ;; Some major modes deactivates the mark, we do not want that:
6352 (font-lock-mode font-lock-mode)
6353 ;; We have to save and reset the cursor type, at least when
6355 (old-cursor-type cursor-type)
6356 ;; Protect last-command: fix-me: probably remove
6357 (last-command last-command)
6358 ;; Fix-me: remove this
6359 (old-rng-schema-file (when (boundp 'rng-current-schema-file-name) rng-current-schema-file-name))
6360 ;; Local vars, per buffer and per major mode
6361 per-buffer-local-vars-state
6362 per-main-major-local-vars-state
6364 ;; We are not changing mode from font-lock's point of view, so do
6365 ;; not tell font-lock (let binding these hooks is probably not a
6366 ;; good choice since they may contain other stuff too):
6367 (setq mumamo-removed-from-hook nil)
6368 (mumamo-remove-from-hook 'change-major-mode-hook mumamo-change-major-mode-no-nos)
6371 ;; Save per buffer local variables
6372 (dolist (sym (reverse mumamo-per-buffer-local-vars))
6374 (when (and (get sym 'permanent-local)
6375 (not (memq sym mumamo-per-buffer-local-vars-done-by-me))
6376 (not (mumamo-hook-p sym)))
6377 (delq sym mumamo-per-buffer-local-vars)
6378 (lwarn 'mumamo-per-buffer-local-vars :warning
6379 "Already 'permanent-local t: %s" sym))))
6380 (dolist (var mumamo-per-buffer-local-vars)
6381 (if (local-variable-p var)
6382 (push (cons var (symbol-value var))
6383 per-buffer-local-vars-state)))
6386 ;; Save per main major local variables
6387 (when (mumamo-fun-eq major-mode (mumamo-main-major-mode))
6388 (dolist (var mumamo-per-main-major-local-vars)
6389 (if (local-variable-p var)
6390 (push (cons var (symbol-value var))
6391 per-main-major-local-vars-state))))
6393 ;; For all hooks that probably can have buffer local values, go
6394 ;; through the buffer local values and look for a permanent-local
6395 ;; property on each function. Remove those functions that does not
6396 ;; have it. Then make the buffer local value of the hook survive
6397 ;; by putting a permanent-local property on it.
6398 (unless (> emacs-major-version 22)
6399 (dolist (hk mumamo-survive-hooks)
6400 (put hk 'permanent-local t)
6401 (when (local-variable-p hk)
6402 (let ((hkv (copy-sequence (symbol-value hk))))
6404 (unless (or (eq v t)
6405 (get v 'permanent-local-hook))
6406 (remove-hook hk v t)
6409 (run-hooks 'mumamo-change-major-mode-hook)
6411 (setq mumamo-major-mode major)
6414 ;; Save per major mode local variables before switching major
6415 (mumamo-save-per-major-local-vars major-mode)
6416 ;; Prepare to restore per major mode local variables after
6417 ;; switching back to major-mode, but do it in the greatest
6418 ;; ancestor's mode hook (see `run-mode-hooks'):
6419 (let (ancestor-hook-sym
6422 ;; We want the greatest ancestor's mode hook:
6423 (setq parent-hook-sym (intern-soft (concat (symbol-name parent) "-hook")))
6424 (when parent-hook-sym (setq ancestor-hook-sym parent-hook-sym))
6425 (while (get parent 'derived-mode-parent)
6426 (setq parent (get parent 'derived-mode-parent))
6427 (setq parent-hook-sym (intern-soft (concat (symbol-name parent) "-hook")))
6428 (when parent-hook-sym (setq ancestor-hook-sym parent-hook-sym)))
6429 (when ancestor-hook-sym
6430 ;; Put first in local hook to run it first:
6431 (setq mumamo-restore-per-major-local-vars-in-hook-major major)
6432 (add-hook ancestor-hook-sym
6433 'mumamo-restore-per-major-local-vars-in-hook
6436 ;;(msgtrc "set-major A: buffer-invisibility-spec=%S" buffer-invisibility-spec)
6437 ;;(msgtrc "set-major A: word-wrap=%S, cb=%s" word-wrap (current-buffer))
6438 ;;(mumamo-backtrace "set-major")
6439 (let ((here (point)))
6442 (let* ((minmax (mumamo-chunk-syntax-min-max chunk t))
6446 ;; Fix-me: For some reason let binding did not help. Is this a bug or?
6448 ;;(font-lock-fontify-buffer-function 'mumamo-font-lock-fontify-chunk)
6449 (old-bf (buffer-local-value 'font-lock-fontify-buffer-function (current-buffer)))
6450 (inhibit-redisplay t) ;; Fix-me: said to be for internal purposes only
6452 (narrow-to-region min max)
6453 (set (make-local-variable 'font-lock-fontify-buffer-function) 'mumamo-font-lock-fontify-chunk)
6454 ;;(message "funcall major=%s, %s" major font-lock-fontify-buffer-function)
6455 ;;(message "before funcall: function=%s" font-lock-fontify-buffer-function)
6456 (put 'font-lock-fontify-buffer-function 'permanent-local t)
6457 (funcall major) ;; <-----------------------------------------------
6458 (put 'font-lock-fontify-buffer-function 'permanent-local nil)
6460 (set (make-local-variable 'font-lock-fontify-buffer-function) old-bf))
6463 ;;(msgtrc "set-major B: buffer-invisibility-spec=%S" buffer-invisibility-spec)
6464 ;;(msgtrc "set-major B: word-wrap=%S, cb=%s" word-wrap (current-buffer))
6466 (setq font-lock-mode-major-mode major) ;; Tell font-lock it is ok
6467 (set (make-local-variable 'font-lock-function) 'mumamo-font-lock-function)
6468 (if (not ancestor-hook-sym)
6469 (mumamo-restore-per-major-local-vars major)
6470 (remove-hook ancestor-hook-sym
6471 'mumamo-restore-per-major-local-vars-in-hook
6473 ;;(msgtrc "set-major c: buffer-invisibility-spec=%S" buffer-invisibility-spec)
6475 (when (mumamo-fun-eq major 'org-mode) (setq mumamo-org-startup-done t))
6477 (setq mumamo-major-mode-indent-line-function (cons major-mode indent-line-function))
6478 (make-local-variable 'indent-line-function)
6480 (setq mode-name (concat (format-mode-line mode-name)
6482 (replace-regexp-in-string
6484 (format "/%s" mumamo-multi-major-mode)))))
6486 (dolist (hk mumamo-survive-hooks) (put hk 'permanent-local nil))
6488 ;; (when (and (featurep 'flymake)
6490 ;; (add-hook 'after-change-functions 'flymake-after-change-function nil t)
6491 ;; (add-hook 'after-save-hook 'flymake-after-save-hook nil t)
6492 ;; (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t))
6495 ;; Restore per buffer local variables
6497 ;; (dolist (sym mumamo-per-buffer-local-vars)
6498 ;; (when (boundp sym)
6499 ;; (put sym 'permanent-local nil)))
6500 ;;(msgtrc "per-buffer-local-vars-state=%S" per-buffer-local-vars-state)
6501 (dolist (saved per-buffer-local-vars-state)
6502 ;;(msgtrc "restore p buffer: %s, local=%s" (car saved) (local-variable-p (car saved)))
6503 (unless (local-variable-p (car saved))
6504 (set (make-local-variable (car saved)) (cdr saved))))
6507 ;; Restore per main major local variables
6508 (unless (mumamo-fun-eq major-mode (mumamo-main-major-mode))
6509 (dolist (saved per-main-major-local-vars-state)
6510 (set (make-local-variable (car saved)) (cdr saved))))
6512 (mumamo-addback-to-hooks)
6514 (setq cursor-type old-cursor-type)
6515 (run-hooks 'mumamo-after-change-major-mode-hook)
6517 (when (derived-mode-p 'nxml-mode)
6518 (when (and old-rng-schema-file
6519 (not (string= old-rng-schema-file rng-current-schema-file-name)))
6520 (let ((rng-schema-change-hook nil)) ;(list 'rng-alidate-clear)))
6523 (rng-set-schema-file-1 old-rng-schema-file)
6525 (nxml-file-parse-error
6526 (nxml-display-file-parse-error err)))
6527 (when rng-validate-mode
6528 ;; Fix-me: Change rng-validate variables so that this is
6529 ;; not necessary any more.
6530 (rng-validate-mode 0)
6531 (rng-validate-mode 1))
6533 ;; The nxml-parser should not die:
6534 (when (mumamo-derived-from-mode (mumamo-main-major-mode) 'nxml-mode)
6535 (add-hook 'after-change-functions 'rng-after-change-function nil t)
6536 (add-hook 'after-change-functions 'nxml-after-change nil t)
6537 ;; Added these for Emacs 22:
6538 (unless nxml-prolog-end (setq nxml-prolog-end 1))
6539 (unless nxml-scan-end (setq nxml-scan-end (copy-marker 1))))
6541 ;;; (when (and global-font-lock-mode
6542 ;;; font-lock-global-modes
6544 ;;; (when global-font-lock-mode
6545 ;;; (add-hook 'change-major-mode-hook 'global-font-lock-mode-cmhh))
6546 ;;; (add-hook 'change-major-mode-hook 'font-lock-change-mode nil t)
6548 (mumamo-set-fontification-functions)
6550 ;; If user has used M-x flyspell-mode then we need to correct it:
6551 ;; Fix-me: This is inflexible. Need flyspell to cooperate.
6552 (when (featurep 'flyspell)
6553 (setq flyspell-generic-check-word-predicate 'mumamo-flyspell-verify))
6555 (if mumamo-done-first-set-major
6556 (setq mumamo-just-changed-major t)
6557 (mumamo-msgfntfy "mumamo-set-major: ----- removing 'fontified")
6558 ;; Set up to fontify buffer
6559 (mumamo-save-buffer-state nil
6560 (remove-list-of-text-properties (point-min) (point-max) '(fontified)))
6561 (setq mumamo-done-first-set-major t))
6563 ;; Timing, on a 3ghz cpu:
6565 ;; used-time=(0 0 0), major-mode=css-mode
6566 ;; used-time=(0 0 0), major-mode=ecmascript-mode
6567 ;; used-time=(0 0 0), major-mode=html-mode
6568 ;; used-time=(0 0 203000), major-mode=nxhtml-mode
6570 ;; After some changes 2007-04-25:
6572 ;; used-time=(0 0 15000), major-mode=nxhtml-mode
6574 ;; which is 15 ms. That seems acceptable though I am not sure
6575 ;; everything is correct when switching to nxhtml-mode yet. I
6576 ;; will have to wait for bug reports ;-)
6578 ;; The delay is clearly noticeable and disturbing IMO unless you
6579 ;; change major mode in an idle timer.
6581 ;;(setq end-time (get-internal-run-time))
6582 ;;(setq used-time (time-subtract end-time start-time))
6584 (setq mumamo-set-major-keymap-checked nil)
6585 ;; Fix-me: Seems like setting/checking the keymap in a timer is
6586 ;; problematc. This is an Emacs bug.
6587 ;;(run-with-idle-timer 1 nil 'mumamo-set-major-check-keymap)
6588 ;;(force-mode-line-update) (message "force-mode-line-update called")
6591 (defun mumamo-set-major-check-keymap ()
6592 "Helper to work around an Emacs bug when setting local map in a timer."
6593 (or mumamo-set-major-keymap-checked
6594 (setq mumamo-set-major-keymap-checked
6595 (let ((map-sym (intern-soft (concat (symbol-name major-mode) "-map"))))
6597 t ;; Don't know what to do
6598 (equal (current-local-map)
6599 (symbol-value map-sym)))))))
6601 (defvar mumamo-original-fill-paragraph-function nil)
6602 (make-variable-buffer-local 'mumamo-original-fill-paragraph-function)
6604 (defun mumamo-setup-local-fontification-vars ()
6605 "Set up buffer local variables for mumamo style fontification."
6606 (make-local-variable 'font-lock-fontify-region-function)
6607 (setq font-lock-fontify-region-function 'mumamo-fontify-region)
6609 ;; Like font-lock-turn-on-thing-lock:
6610 (make-local-variable 'font-lock-fontify-buffer-function)
6611 (setq font-lock-fontify-buffer-function 'jit-lock-refontify)
6612 (setq font-lock-fontify-buffer-function 'mumamo-fontify-buffer)
6613 ;; Don't fontify eagerly (and don't abort if the buffer is large).
6614 (set (make-local-variable 'font-lock-fontified) t)
6616 (make-local-variable 'font-lock-unfontify-buffer-function)
6617 (setq font-lock-unfontify-buffer-function 'mumamo-unfontify-buffer)
6619 (set (make-local-variable 'indent-line-function) 'mumamo-indent-line-function)
6621 ;;(setq mumamo-original-fill-paragraph-function fill-paragraph-function)
6622 ;;(set (make-local-variable 'fill-paragraph-function) 'mumamo-fill-paragraph-function)
6623 ;;(set (make-local-variable 'fill-forward-paragraph-function 'forward-paragraph)
6625 (make-local-variable 'indent-region-function)
6626 (setq indent-region-function 'mumamo-indent-region-function)
6628 ;;(set (make-local-variable 'syntax-begin-function) 'mumamo-beginning-of-syntax)
6630 ;;(put 'font-lock-function 'permanent-local t)
6632 ;; FIX-ME: Not sure about this one, but it looks like it must be
6634 (make-local-variable 'jit-lock-contextually)
6635 (setq jit-lock-contextually t)
6638 (defun mumamo-font-lock-function (mode)
6639 ;;(mumamo-backtrace "font-lock-function")
6640 (font-lock-default-function mode))
6643 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6644 ;;;; Turning on/off multi major modes
6646 (defun mumamo-set-fontification-functions ()
6647 "Let mumamo take over fontification.
6648 This is run after changing major mode so that jit-lock will get
6649 the major mode specific values. \(There are currently no such
6651 ;; Give the jit machinery a starting point:
6652 (mumamo-jit-lock-register 'font-lock-fontify-region t)
6653 ;; Set the functions that font-lock should use:
6654 (mumamo-setup-local-fontification-vars)
6655 ;; Need some hook modifications to keep things together too:
6656 (add-hook 'change-major-mode-hook 'mumamo-change-major-function nil t)
6657 (add-hook 'post-command-hook 'mumamo-post-command nil t)
6658 (remove-hook 'change-major-mode-hook 'nxml-change-mode t)
6659 (remove-hook 'change-major-mode-hook 'nxhtml-change-mode t)
6662 (defun mumamo-initialize-state ()
6663 "Initialize some mumamo state variables."
6664 (setq mumamo-done-first-set-major nil)
6665 (setq mumamo-just-changed-major nil))
6667 (defun mumamo-turn-on-actions (old-major-mode)
6668 "Do what is necessary to turn on mumamo.
6669 Turn on minor mode function `font-lock-mode'.
6670 Set up for mumamo style fontification.
6671 Create a mumamo chunk at point.
6672 Run `mumamo-turn-on-hook'.
6674 OLD-MAJOR-MODE is used for the main major mode if the main major
6675 mode in the chunk family is nil."
6676 ;;(unless font-lock-mode (font-lock-mode 1))
6677 (mumamo-msgfntfy "mumamo-turn-on-actions")
6678 (unless mumamo-current-chunk-family (error "Internal error: Chunk family is not set"))
6679 (if (not mumamo-current-chunk-family)
6681 (lwarn '(mumamo) :warning
6682 "Could not turn on mumamo because chunk family was not set\n\tin buffer %s."
6684 (with-current-buffer "*Warnings*"
6685 (insert "\tFor more information see `")
6686 (mumamo-insert-describe-button 'define-mumamo-multi-major-mode 'describe-function)
6689 (setq mumamo-org-startup-done nil)
6690 (let ((main-major-mode (mumamo-major-mode-from-modespec (mumamo-main-major-mode))))
6691 (unless main-major-mode
6692 (setcar (cdr mumamo-current-chunk-family) old-major-mode)
6693 (setq main-major-mode (mumamo-main-major-mode)))
6694 ;;(with-temp-buffer (funcall main-major-mode))
6695 (setq mumamo-major-mode main-major-mode)
6696 (when (boundp 'nxml-syntax-highlight-flag)
6697 (when (mumamo-derived-from-mode main-major-mode 'nxml-mode)
6698 (set (make-local-variable 'nxml-syntax-highlight-flag) nil)))
6699 ;; Init fontification
6700 (mumamo-initialize-state)
6701 (mumamo-set-fontification-functions)
6702 (mumamo-save-buffer-state nil
6703 (remove-list-of-text-properties (point-min) (point-max)
6705 ;; For validation header etc:
6706 (when (mumamo-derived-from-mode main-major-mode 'nxhtml-mode)
6707 (require 'rngalt nil t)
6708 (when (featurep 'rngalt)
6709 (setq rngalt-major-mode (mumamo-main-major-mode))
6710 (rngalt-update-validation-header-overlay))
6711 (when (featurep 'rng-valid)
6712 (setq rng-get-major-mode-chunk-function 'mumamo-find-chunks)
6713 (setq rng-valid-nxml-major-mode-chunk-function 'mumamo-valid-nxml-chunk)
6714 (setq rng-end-major-mode-chunk-function 'overlay-end))))
6715 ;;(mumamo-set-major-post-command)
6716 ;;(add-hook 'change-major-mode-hook 'mumamo-change-major-function nil t)
6717 (when (boundp 'flyspell-generic-check-word-predicate)
6718 (setq flyspell-generic-check-word-predicate 'mumamo-flyspell-verify))
6719 (run-hooks 'mumamo-turn-on-hook)
6720 ;;(mumamo-get-chunk-save-buffer-state (point))
6721 (let ((buffer-windows (get-buffer-window-list (current-buffer))))
6722 (if (not buffer-windows)
6723 (let* ((ovl (mumamo-find-chunks (point) "mumamo-turn-on-actions"))
6724 (major (when ovl (mumamo-chunk-major-mode ovl))))
6726 (mumamo-set-major major ovl)))
6727 (dolist (win (get-buffer-window-list (current-buffer) nil t))
6728 (let ((wp (or (window-end win)
6730 (window-start win))))
6731 (mumamo-get-chunk-save-buffer-state wp)
6732 (when (eq win (selected-window))
6733 (let* ((ovl (mumamo-find-chunks wp "mumamo-turn-on-actions"))
6734 (major (when ovl (mumamo-chunk-major-mode ovl))))
6736 (mumamo-set-major major ovl))))))))
6737 ;;(msgtrc "mumamo-turn-on-action exit: font-lock-keywords-only =%s in buffer %s, def=%s" font-lock-keywords-only (current-buffer) (default-value 'font-lock-keywords-only))
6738 ;; This did not help for Emacs bug 3467:
6739 ;;(set-default 'font-lock-keywords-only nil)
6740 ;;(setq font-lock-keywords-only nil)
6742 (set (make-local-variable 'font-lock-function) 'mumamo-font-lock-function)
6743 (mumamo-emacs-start-bug3467-timer-if-needed)
6746 ;; (defun mumamo-on-font-lock-off ()
6747 ;; "The reverse of `mumamo-turn-on-actions'."
6748 ;; (let ((mumamo-main-major-mode (mumamo-main-major-mode)))
6749 ;; (mumamo-turn-off-actions)
6750 ;; ;; Turning off `font-lock-mode' also turns off `mumamo-mode'. It is
6751 ;; ;; quite tricky to not turn on `font-lock-mode' again in case we got
6752 ;; ;; here because it was turned off. We must first remove the cmhh
6753 ;; ;; function and then also run the internal font lock turn off.
6754 ;; (let* ((flm font-lock-mode)
6755 ;; (flgm global-font-lock-mode)
6756 ;; (remove-cmhh (and (not flm) flgm)))
6757 ;; ;; If remove-cmhh is non-nil then we got here because
6758 ;; ;; `font-lock-mode' was beeing turned off in the buffer, but
6759 ;; ;; `global-font-lock-mode' is still on.
6760 ;; (when remove-cmhh
6761 ;; (remove-hook 'change-major-mode-hook 'global-font-lock-mode-cmhh))
6763 ;; (if mumamo-main-major-mode
6764 ;; (funcall mumamo-main-major-mode)
6765 ;; (fundamental-mode))
6768 ;; (setq font-lock-mode nil)
6769 ;; (font-lock-mode-internal nil))
6770 ;; (when remove-cmhh
6771 ;; (add-hook 'change-major-mode-hook 'global-font-lock-mode-cmhh)))))
6773 (defun mumamo-turn-off-actions ()
6774 "The reverse of `mumamo-turn-on-actions'."
6775 (mumamo-msgfntfy "mumamo-turn-off-actions")
6776 (when (fboundp 'nxhtml-validation-header-mode)
6777 (nxhtml-validation-header-mode -1))
6778 (when (mumamo-derived-from-mode
6779 (nth 1 mumamo-current-chunk-family) 'nxml-mode)
6780 (when (fboundp 'nxml-change-mode)
6781 (nxml-change-mode)))
6782 (when (and (boundp 'rng-validate-mode)
6784 (rng-validate-mode 0))
6785 (when (featurep 'rng-valid)
6786 (setq rng-get-major-mode-chunk-function nil)
6787 (setq rng-valid-nxml-major-mode-chunk-function nil)
6788 (setq rng-end-major-mode-chunk-function nil)
6790 ;; Remove nxml for Emacs 22
6791 (remove-hook 'after-change-functions 'rng-after-change-function t)
6792 (remove-hook 'after-change-functions 'nxml-after-change t)
6793 (when (boundp 'rngalt-major-mode)
6794 (setq rngalt-major-mode nil))
6795 (remove-hook 'change-major-mode-hook 'mumamo-change-major-function t)
6796 ;;(mumamo-unfontify-chunks)
6797 ;;(remove-hook 'after-change-functions 'mumamo-jit-lock-after-change t)
6798 (remove-hook 'after-change-functions 'mumamo-after-change t)
6799 (remove-hook 'post-command-hook 'mumamo-post-command t)
6800 ;;(remove-hook 'c-special-indent-hook 'mumamo-c-special-indent t)
6801 (mumamo-margin-info-mode -1)
6802 (when (fboundp 'mumamo-clear-all-regions) (mumamo-clear-all-regions))
6805 (mumamo-save-buffer-state nil
6806 (set-text-properties (point-min) (point-max) nil)))
6807 (setq mumamo-current-chunk-family nil)
6808 (setq mumamo-major-mode nil)
6809 (setq mumamo-multi-major-mode nil) ;; for minor-mode-map-alist
6810 (setq mumamo-multi-major-mode nil)
6811 (mumamo-remove-all-chunk-overlays)
6812 (when (fboundp 'rng-cancel-timers) (rng-cancel-timers))
6815 (defvar mumamo-turn-on-hook nil
6816 "Normal hook run after turning on `mumamo-mode'.")
6817 (put 'mumamo-turn-on-hook 'permanent-local t)
6819 (defvar mumamo-change-major-mode-hook nil
6820 "Normal hook run before internal change of major mode.")
6821 (put 'mumamo-change-major-mode-hook 'permanent-local t)
6823 (defvar mumamo-after-change-major-mode-hook nil
6824 "Normal hook run after internal change of major mode.")
6825 (put 'mumamo-after-change-major-mode-hook 'permanent-local t)
6830 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6831 ;;;; Defining multi major modes
6833 (defvar mumamo-defined-multi-major-modes nil
6834 "List of functions defined for turning on mumamo.
6835 Those functions should be called instead of calling a major mode
6836 function when you want to use multiple major modes in a buffer.
6837 They may be added to for example `auto-mode-alist' to
6838 automatically have the major mode support turned on when opening
6841 Each of these functions defines how to mix certain major modes in
6844 All functions defined by `define-mumamo-multi-major-mode' are
6845 added to this list. See this function for a general description
6846 of how the functions work.
6848 If you want to quickly define a new mix of major modes you can
6849 use `mumamo-quick-static-chunk'.")
6852 (defun mumamo-list-defined-multi-major-modes (show-doc show-chunks match)
6853 "List currently defined multi major modes.
6854 If SHOW-DOC is non-nil show the doc strings added when defining
6855 them. \(This is not the full doc string. To show the full doc
6856 string you can click on the multi major mode in the list.)
6858 If SHOW-CHUNKS is non-nil show the names of the chunk dividing
6859 functions each multi major mode uses.
6861 If MATCH then show only multi major modes whos names matches."
6862 (interactive (list (y-or-n-p "Include short doc string? ")
6863 (y-or-n-p "Include chunk function names? ")
6864 (read-string "List only multi major mode matching regexp (emtpy for all): ")))
6865 (with-output-to-temp-buffer (help-buffer)
6866 (help-setup-xref (list #'mumamo-list-defined-multi-major-modes) (interactive-p))
6867 (with-current-buffer (help-buffer)
6868 (insert "The currently defined multi major modes in your Emacs are:\n\n")
6869 (let ((mmms (reverse mumamo-defined-multi-major-modes))
6871 (setq mmms (sort mmms (lambda (a b)
6872 (string< (symbol-name (cdr a))
6873 (symbol-name (cdr b))))))
6874 (when (string= match "") (setq match nil))
6876 (let* ((mmm (car mmms))
6879 (auto (get sym 'autoload))
6880 (auto-desc (when auto (nth 1 auto)))
6881 (family (get sym 'mumamo-chunk-family))
6882 (chunks (nth 2 family)))
6883 (when (or (not match)
6884 (string-match-p match (symbol-name sym)))
6885 (insert " `" (symbol-name sym) "'"
6887 (if (and show-doc auto-desc)
6888 (concat " " auto-desc "\n")
6891 (format " Chunks:%s\n"
6896 (setq str (concat str " "))
6898 (setq str (concat str "\n ")))
6900 (setq str (concat str (format "%-30s" (format "`%s'" c))))
6905 (if (or show-doc show-chunks) "\n\n" "")
6907 (setq mmms (cdr mmms))))
6910 (defun mumamo-describe-chunks (chunks)
6911 "Return text describing CHUNKS."
6913 (concat "* Main major mode: `" (symbol-name (nth 1 chunks)) "'\n"
6914 "\n* Functions for dividing into submodes:\n")))
6915 (dolist (divider (nth 2 chunks))
6919 "\n`" (symbol-name divider)
6921 (let ((doc (if (functionp divider)
6922 (documentation divider t)
6923 "(Function not compiled when building doc)")))
6926 (substring doc 0 (string-match "\n" doc)))))))
6930 "\n\n(Note that the functions for dividing into chunks returns\n"
6931 "a major mode specifier which may be translated into a major mode\n"
6932 "by `mumamo-main-major-mode'.)\n"))
6935 (defun mumamo-add-multi-keymap (toggle keymap)
6936 "Add TOGGLE and KEYMAP to `minor-mode-map-alist'.
6937 This is used to add a keymap to multi major modes since the local
6938 keymap is occupied by the major modes.
6940 It is also used to add the `mumamo-map' keymap to every buffer
6941 with a multi major mode."
6942 ;; Copied from add-minor-mode
6943 ;; Add the map to the minor-mode-map-alist.
6945 (let ((existing (assq toggle minor-mode-map-alist))
6948 (setcdr existing keymap)
6949 (let ((tail minor-mode-map-alist) found)
6950 (while (and tail (not found))
6951 (if (eq after (caar tail))
6953 (setq tail (cdr tail))))
6955 (let ((rest (cdr found)))
6957 (nconc found (list (cons toggle keymap)) rest))
6958 (setq minor-mode-map-alist (cons (cons toggle keymap)
6959 minor-mode-map-alist))))))))
6962 (let ((map (make-sparse-keymap)))
6963 (define-key map [(control meta prior)] 'mumamo-backward-chunk)
6964 (define-key map [(control meta next)] 'mumamo-forward-chunk)
6965 ;; Use mumamo-indent-line-function:
6966 ;;(define-key map [tab] 'indent-for-tab-command)
6967 (define-key map [(meta ?q)] 'fill-paragraph)
6969 "Keymap that is active in all mumamo buffers.
6970 It has the some priority as minor mode maps.")
6971 ;;(make-variable-buffer-local 'mumamo-map)
6972 (put 'mumamo-map 'permanent-local t)
6974 (mumamo-add-multi-keymap 'mumamo-multi-major-mode mumamo-map)
6977 (defun mumamo-multi-major-modep (value)
6978 "Return t if VALUE is a multi major mode function."
6979 (and (fboundp value)
6980 (rassq value mumamo-defined-multi-major-modes)))
6983 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
6984 ;;;; Indenting, filling, moving etc
6986 ;; FIX-ME: Indentation in perl here doc indents the ending mark which
6987 ;; corrupts the perl here doc.
6989 (defun mumamo-indent-line-function ()
6990 "Function to indent the current line.
6991 This is the buffer local value of `indent-line-function' when
6993 (let ((here (point-marker))
6994 fontification-functions
6995 rng-nxml-auto-validate-flag
6996 (before-text (<= (current-column) (current-indentation))))
6997 (mumamo-indent-line-function-1 nil nil nil)
6998 ;; If the marker was in the indentation part strange things happen
6999 ;; if we try to go back to the marker, at least in php-mode parts.
7001 (back-to-indentation)
7004 (defun mumamo-indent-current-line-chunks (last-chunk-prev-line)
7005 "Return a list of chunks to consider when indenting current line.
7006 This list consists of four chunks at these positions:
7007 - Beginning of line - 1
7011 ;; Fix-me: must take markers into account too when a submode
7012 ;; includes the markers.
7013 (setq last-chunk-prev-line nil)
7014 ;;(msgtrc "indent-current-line-chunks: last-chunk-prev-line=%S" last-chunk-prev-line)
7017 (let* ((lb-pos (line-beginning-position))
7018 (le-pos (line-end-position))
7019 (pos0 (if (> lb-pos (point-min))
7024 (pos3 (if (< le-pos (point-max))
7027 ;; Create all chunks on this line first, then grab them
7028 (ovl3 (mumamo-find-chunks pos3 "mumamo-indent-current-line-chunks"))
7029 (ovl2 (if (>= pos2 (overlay-start ovl3))
7031 (mumamo-get-existing-new-chunk-at pos2)))
7032 (ovl1 (if (>= pos1 (overlay-start ovl2))
7034 (mumamo-get-existing-new-chunk-at pos1)))
7035 (ovl0 (if (> pos0 (overlay-start ovl1))
7037 (mumamo-get-existing-new-chunk-at pos0 t))))
7038 (list ovl0 ovl1 ovl2 ovl3))))
7040 ;; Fix-me: need to back up past comments in for example <style> /* comment */
7042 (put 'mumamo-error-ind-0 'error-conditions '(error mumamo-error-ind-0))
7043 (put 'mumamo-error-ind-0 'error-message "indentation 0 in sub chunk")
7047 ;;;;;;;;;;;;;;;;;;;;;;;;
7048 ;; Template indentation
7049 ;;; Contact Marc Bowes when I've finished this.
7051 (defvar mumamo-template-indent-buffer nil)
7052 (make-variable-buffer-local 'mumamo-template-indent-buffer)
7053 (put 'mumamo-template-indent-buffer 'permanent-local t)
7055 (defvar mumamo-template-indent-change-min nil)
7056 (make-variable-buffer-local 'mumamo-template-indent-change-min)
7057 (put 'mumamo-template-indent-hange-min 'permanent-local t)
7059 (defun mumamo-template-indent-after-change (beg end len)
7060 (setq mumamo-template-indent-change-min
7061 (if mumamo-template-indent-change-min
7062 (min mumamo-template-indent-change-min beg)
7065 ;; (defun mumamo-get-indentor-create (indentor-chunk prev-indentor)
7066 ;; (let ((indentor (overlay-get indentor-chunk 'mumamo-indentor))
7067 ;; (indentor-buffer (when indentor (overlay-buffer indentor)))
7068 ;; (chunk-str (with-current-buffer (overlay-buffer indentor-chunk)
7069 ;; (buffer-substring-no-properties (overlay-start indentor-chunk)
7070 ;; (overlay-end indentor-chunk))))
7072 ;; (unless (and indentor
7073 ;; (eq indentor-buffer mumamo-template-indent-buffer)
7074 ;; (string= chunk-str (overlay-get indentor 'indentor-chunk-string)))
7076 ;; (when (buffer-live-p
7079 (defun mumamo-indentor-valid (indentor chunk chunk-string)
7082 (buffer-live-p (overlay-buffer chunk))
7083 (string= chunk-string (overlay-get indentor 'indentor-chunk-string))
7086 (defun mumamo-template-indent-get-chunk-shift (indentor-chunk)
7087 "Return indentation shift for INDENTOR-CHUNK row and line after.
7088 ;; Fix-me: Handle changes better.
7090 Indentation shift has two parts: shift for current line and for next line.
7091 This function returns a cons with these two parts.
7093 (assert (overlayp indentor-chunk) t)
7094 (assert (buffer-live-p (overlay-buffer indentor-chunk)) t)
7095 (let ((indentor (overlay-get indentor-chunk 'mumamo-indentor))
7096 (prev-chunk (overlay-get indentor-chunk 'mumamo-prev-chunk))
7097 prev-indentor prev-indentor-chunk)
7098 (when indentor (assert (eq indentor-chunk (overlay-get indentor 'indentor-chunk)) t))
7099 (unless (and mumamo-template-indent-buffer
7100 (buffer-live-p mumamo-template-indent-buffer))
7102 (setq mumamo-template-indent-buffer
7103 (get-buffer-create (concat (buffer-name)
7104 "-template-indent-buffer")))
7105 (with-current-buffer mumamo-template-indent-buffer
7106 (setq buffer-undo-list t)
7107 (let ((major (car (overlay-get indentor-chunk 'mumamo-major-mode))))
7110 (unless (eq (overlay-buffer indentor) mumamo-template-indent-buffer)
7111 (setq indentor nil)))
7112 ;; We need the prev indentor to indent relative to.
7113 (while (and prev-chunk (not prev-indentor-chunk))
7114 (setq prev-chunk (overlay-get prev-chunk 'mumamo-prev-chunk))
7116 (when (eq (overlay-get prev-chunk 'mumamo-next-indent)
7117 'mumamo-template-indentor)
7118 (setq prev-indentor-chunk (overlay-get prev-chunk 'mumamo-next-chunk)))))
7119 (when prev-indentor-chunk
7120 (setq prev-indentor (overlay-get prev-indentor-chunk 'mumamo-indentor)))
7122 (unless (buffer-live-p (overlay-buffer prev-indentor))
7123 (setq prev-indentor nil)))
7124 (when prev-indentor (assert (eq (overlay-buffer prev-indentor) mumamo-template-indent-buffer) t))
7125 (with-current-buffer mumamo-template-indent-buffer
7128 ;; Insert a blank line to be able to go to start of first
7129 ;; overlay -1. Do it here in case the user erases the buffer.
7130 (when (= 0 (buffer-size)) (insert "\n"))
7131 (let ((i-str (when indentor
7132 (buffer-substring-no-properties (overlay-start indentor) (overlay-end indentor))))
7133 (i-beg (when indentor (overlay-start indentor)))
7134 (c-str (with-current-buffer (overlay-buffer indentor-chunk)
7135 (buffer-substring-no-properties (overlay-start indentor-chunk)
7136 (overlay-end indentor-chunk))))
7137 (p-str (when prev-indentor-chunk
7138 (with-current-buffer (overlay-buffer prev-indentor-chunk)
7139 (buffer-substring-no-properties (overlay-start prev-indentor-chunk)
7140 (overlay-end prev-indentor-chunk)))))
7141 (c-beg (overlay-start indentor-chunk))
7142 (p-beg (when prev-indentor-chunk (overlay-start prev-indentor-chunk))))
7143 ;; Check if `indentor' and `prev-indentor' are valid
7145 ;;(unless (string= c-str (overlay-get indentor 'indentor-chunk-string))
7146 (unless (mumamo-indentor-valid indentor indentor-chunk c-str)
7147 (mumamo-remove-indentor indentor)))
7149 ;;(unless (string= p-str (overlay-get prev-indentor 'indentor-chunk-string))
7150 (unless (mumamo-indentor-valid prev-indentor prev-indentor-chunk p-str)
7151 (mumamo-remove-indentor prev-indentor)))
7156 ;; We just put `indentor' after this, but we
7157 ;; must also remove old stuff.
7158 (goto-char (overlay-end prev-indentor))
7160 (let* ((next-indentor (mumamo-indentor-at (point)))
7161 (next-indentor-chunk (when next-indentor
7162 (overlay-get next-indentor 'indentor-chunk)))
7164 (new-i-beg (unless next-indentor-chunk (point))))
7165 (while (not new-i-beg)
7166 (setq n-beg (when (buffer-live-p (overlay-buffer next-indentor-chunk))
7167 (overlay-start next-indentor-chunk)))
7168 (if (or (not n-beg) (< n-beg c-beg))
7170 (mumamo-remove-indentor next-indentor)
7171 (goto-char (overlay-end prev-indentor))
7173 (setq next-indentor (mumamo-indentor-at (point)))
7175 (setq next-indentor-chunk (overlay-get next-indentor 'indentor-chunk))
7176 (setq new-i-beg (point))))
7177 (setq new-i-beg (point))))
7179 ;; Fix-me: Find out where to insert indentor:
7182 mm new-i-beg m-ovl m-ovl-old m-chunk m-beg)
7184 (setq mm (+ ll (/ (- rr ll) 2)))
7185 (setq m-ovl-old m-ovl)
7186 (setq m-ovl (mumamo-indentor-at mm))
7187 (if (or (not m-ovl) (eq m-ovl m-ovl-old))
7189 (setq m-chunk (overlay-get m-ovl 'indentor-chunk))
7190 (setq m-beg (when (buffer-live-p (overlay-buffer m-chunk))
7191 (overlay-start m-chunk)))
7193 (mumamo-remove-indentor m-ovl)
7194 (setq rr (min rr (point-max))))
7199 (t (error "Found old indentor at %s belonging to %S" mm m-chunk)))))
7200 ;;(1+ (if m-ovl (overlay-end m-ovl) 0))
7201 (if m-ovl (1+ (overlay-end m-ovl)) 2)
7204 (setq indentor (mumamo-make-indentor indentor-chunk c-str)))
7205 (unless prev-indentor
7206 (when prev-indentor-chunk
7207 (goto-char (overlay-start indentor))
7208 (goto-char (point-at-bol))
7209 (setq prev-indentor (mumamo-make-indentor prev-indentor-chunk p-str))))
7210 (when prev-indentor (mumamo-indent-indentor prev-indentor))
7211 (mumamo-indent-indentor indentor)
7212 (let (prev-ind this-ind next-ind shift-in shift-out)
7214 (goto-char (overlay-end prev-indentor))
7215 (setq prev-ind (current-indentation)))
7216 (goto-char (overlay-start indentor))
7217 (setq this-ind (current-indentation))
7218 (goto-char (overlay-end indentor))
7219 (setq next-ind (current-indentation))
7220 (when prev-ind (setq shift-in (- this-ind prev-ind)))
7221 (setq shift-out (- next-ind this-ind))
7222 (msgtrc "template-indent-get-shunk-shift => (%s . %s)" shift-in shift-out)
7223 (cons shift-in shift-out)))))))
7226 (defun mumamo-ruby-beginning-of-indent ()
7228 ;; I don't understand this function.
7229 ;; It seems like it should move to the line where indentation should deepen,
7230 ;; but ruby-indent-beg-re only accounts for whitespace before class, module and def,
7231 ;; so this will only match other block beginners at the beginning of the line.
7234 (re-search-backward (concat "^\\(" ruby-indent-beg-re "\\)\\b") nil 'move)
7235 (skip-chars-forward " \t\n\r"))
7236 (beginning-of-line)))
7238 (defadvice ruby-beginning-of-indent (around
7239 mumamo-ad-ruby-beginning-of-indent
7244 (mumamo-ruby-beginning-of-indent)
7248 (defun mumamo-indentor-at (pos)
7249 "Return indentor overlay at POS."
7250 (let ((here (point))
7253 (setq eol-pos (line-end-position))
7256 (dolist (ovl (or (overlays-at eol-pos)
7258 (overlays-at (1- eol-pos)))))
7259 (when (overlay-get ovl 'indentor-chunk)
7260 (throw 'ind ovl))))))
7262 (defun mumamo-remove-indentor (indentor)
7264 (goto-char (overlay-start indentor))
7265 (setq beg (point-at-bol))
7266 (goto-char (overlay-end indentor))
7267 (setq end (1+ (point-at-eol)))
7268 (delete-region beg end)
7269 (delete-overlay indentor)
7270 (setq indentor nil)))
7272 (defun mumamo-indent-indentor (indentor)
7273 (goto-char (overlay-start indentor))
7274 (if (= 2 (point-at-bol))
7276 (back-to-indentation)
7277 (delete-region 2 (point))
7279 (indent-according-to-mode))
7280 (goto-char (overlay-end indentor))
7281 (indent-according-to-mode))
7283 (defun mumamo-make-indentor (indentor-chunk chunk-string)
7284 (let* ((beg (point))
7285 (syntax-min-max (mumamo-chunk-syntax-min-max indentor-chunk t))
7286 (inner (with-current-buffer (overlay-buffer indentor-chunk)
7287 (buffer-substring-no-properties (cdr syntax-min-max)
7288 (car syntax-min-max))))
7292 (setq indentor (make-overlay beg (1- (point)) nil t t))
7293 (overlay-put indentor 'indentor-chunk indentor-chunk)
7294 (overlay-put indentor 'face 'secondary-selection)
7295 (overlay-put indentor 'indentor-chunk-string chunk-string)
7296 (overlay-put indentor-chunk 'mumamo-indentor indentor)
7299 ;;(mumamo-fun-eq 'js-mode 'javascript-mode)
7300 (defun mumamo-fun-eq (fun1 fun2)
7301 "Return non-nil if same functions or aliases."
7304 (while (and (fboundp fun1)
7305 (symbolp (symbol-function fun1)))
7306 (setq fun1 (symbol-function fun1)))
7307 (while (and (fboundp fun2)
7308 (symbolp (symbol-function fun2)))
7309 (setq fun2 (symbol-function fun2)))
7312 (defun mumamo-indent-line-function-1 (prev-line-chunks
7313 last-parent-major-indent
7314 entering-submode-arg)
7315 ;; Fix-me: error indenting in xml-as-string at <?\n?>
7316 ;; Fix-me: clean up, use depth diff. go back to sibling not to main etc.
7317 ;; Fix-me: Add indentation hints to chunks, for example heredocs and rhtml.
7318 ;; Fix-me: maybe use special indentation functions for certain multi major modes? rhtml?
7319 "Indent current line.
7320 When doing that care must be taken if this line's major modes at
7321 the start and end are different from previous line major modes.
7322 The latter may be known through the parameter PREV-LINE-CHUNKS.
7324 Also the indentation of the last previous main major line may be
7325 necessary to know. This may be known through the parameter
7326 LAST-PARENT-MAJOR-INDENT.
7328 If the two parameters above are nil then this function will
7329 search backwards in the buffer to try to determine their values.
7331 The following rules are used when indenting:
7333 - If the major modes are the same in this and the previous line
7334 then indentation is done using that major mode.
7336 - Exception: If the chunks are not the same AND there is
7337 precisely one chunk between them which have the property value
7338 of 'mumamo-next-indent equal to 'mumamo-template-indentor then
7339 a special indent using the content of the middle chunk is
7340 done. An example of this is eRuby where a middle chunk could
7345 This example will increase indentation for the next line the
7346 same way as the chunk content would do in single major mode
7349 FIXE-ME: IMPLEMENT THE ABOVE!
7351 - Otherwise if going into a submode indentation is increased by
7352 `mumamo-submode-indent-offset' (if this is nil then indentation
7355 - However first non-empty line indentation in a chunk when going
7356 in is special if prev-prev chunk is on same mumamo-depth and
7357 have the same major mode. Then indent relative last non-empty
7358 line in prev-prev chunk.
7360 - When going out of a submode indentation is reset to
7361 LAST-PARENT-MAJOR-INDENT.
7363 - At the border the 'dividers' should be indented as the parent
7364 chunk. There are the following typical situations regarding
7365 inner/outer major modes:
7367 1) <style type='text/css'>
7368 Going in next line; first char outer; line end inner;
7371 Going out this line; First char inner or outer; line end outer;
7374 Going in next line; first char outer or inner; line end inner;
7377 Going out this line; first char inner; line end outer;
7379 From this we deduce the following way to compute if we are
7382 - Odd above (going in): Compare prev line end's mumamo-depth
7383 with current line end's dito. Set flag for first line in
7386 - Even above (going out): Same test as for going in, but going
7387 out happens on current line.
7389 ;;(msgtrc "indent-line-function-1 blp=%s" (line-beginning-position))
7390 (setq prev-line-chunks nil)
7391 ;;(setq last-parent-major-indent nil)
7392 ;;(setq entering-submode-arg nil)
7393 (unless prev-line-chunks
7395 (goto-char (line-beginning-position 1))
7396 (unless (= (point) 1)
7397 (skip-chars-backward "\n\t ")
7398 (goto-char (line-beginning-position 1))
7399 (setq prev-line-chunks (mumamo-indent-current-line-chunks nil))
7400 ;;(msgtrc "%d:prev-line-chunks=%S" (save-restriction (widen) (line-number-at-pos)) prev-line-chunks )
7402 (let* ((prev-line-chunk0 (nth 0 prev-line-chunks))
7403 (prev-line-chunk2 (nth 2 prev-line-chunks))
7404 (prev-line-chunk3 (nth 3 prev-line-chunks))
7405 (prev-line-major0 (mumamo-chunk-major-mode (nth 0 prev-line-chunks)))
7406 (prev-line-major1 (mumamo-chunk-major-mode (nth 1 prev-line-chunks)))
7407 (prev-line-major2 (mumamo-chunk-major-mode (nth 2 prev-line-chunks)))
7408 (prev-line-major3 (mumamo-chunk-major-mode (nth 3 prev-line-chunks)))
7409 (prev-depth2 (if prev-line-chunk2
7410 (overlay-get prev-line-chunk2 'mumamo-depth)
7412 (prev-depth3 (if prev-line-chunk3
7413 (overlay-get prev-line-chunk3 'mumamo-depth)
7416 (this-line-chunks (mumamo-indent-current-line-chunks (nth 3 prev-line-chunks)))
7417 ;;(dummy (msgtrc "%d:this-line-chunks=%S" (save-restriction (widen) (line-number-at-pos)) this-line-chunks))
7418 (this-line-chunk0 (nth 0 this-line-chunks))
7419 (this-line-chunk2 (nth 2 this-line-chunks))
7420 (this-line-chunk3 (nth 3 this-line-chunks))
7421 (this-line-major0 (mumamo-chunk-major-mode (nth 0 this-line-chunks)))
7422 (this-line-major1 (mumamo-chunk-major-mode (nth 1 this-line-chunks)))
7423 (this-line-major2 (mumamo-chunk-major-mode (nth 2 this-line-chunks)))
7424 (this-line-major3 (mumamo-chunk-major-mode (nth 3 this-line-chunks)))
7425 (this-depth2 (overlay-get this-line-chunk2 'mumamo-depth))
7426 (this-depth3 (overlay-get this-line-chunk3 'mumamo-depth))
7428 ;;(dummy (msgtrc "a\t this=%S" this-line-chunks))
7429 this-line-indent-major
7430 major-indent-line-function
7431 (main-major (mumamo-main-major-mode))
7432 (old-indent (current-indentation))
7433 (next-entering-submode (if (< prev-depth3 this-depth3) 'yes 'no))
7437 (unless nil ;entering-submode-arg
7438 (let* ((prev-prev-line-chunks
7440 (goto-char (line-beginning-position 0))
7442 (skip-chars-backward "\n\t ")
7443 (goto-char (line-beginning-position 1))
7444 (let ((chunks (mumamo-indent-current-line-chunks nil)))
7445 ;;(msgtrc "%d:prev-prev-line-chunks=%S" (save-restriction (widen) (line-number-at-pos)) chunks)
7447 (prev-prev-line-chunk2 (nth 2 prev-prev-line-chunks))
7448 (prev-prev-line-chunk3 (nth 3 prev-prev-line-chunks))
7449 (prev-prev-depth2 (when prev-prev-line-chunk2
7450 (overlay-get prev-prev-line-chunk2 'mumamo-depth)))
7451 (prev-prev-depth3 (when prev-prev-line-chunk3
7452 (overlay-get prev-prev-line-chunk3 'mumamo-depth))))
7453 ;;(msgtrc "depths 2=%s/%s/%s 3=%s/%s/%s" prev-prev-depth2 prev-depth2 this-depth2 prev-prev-depth3 prev-depth3 this-depth3)
7454 (setq entering-submode-arg
7455 (if prev-prev-depth2
7456 (if (and (eq prev-prev-line-chunk2
7457 (overlay-get prev-line-chunk2 'mumamo-prev-chunk))
7458 (< prev-prev-depth2 prev-depth2))
7461 (if (> this-depth2 0) 'yes 'no)
7464 (eq 'yes entering-submode-arg)
7467 (leaving-submode (> prev-depth2 this-depth2))
7468 want-indent ;; The indentation we desire
7470 (here-on-line (point-marker))
7471 this-pending-undo-list
7475 ;; Is there a possible indentor chunk on this line?:
7476 (this-line-indentor-chunk (when (> (overlay-start this-line-chunk2)
7478 (overlay-get this-line-chunk2 'mumamo-prev-chunk)))
7479 ;;(dummy (msgtrc "this-line-indentor-chunk=%S" this-line-indentor-chunk))
7480 ;; Check if this really is an indentor chunk:
7481 ;; Fix-me: 'mumamo-indentor is not put on the chunk yet since
7482 ;; it is done in mumamo-template-indent-get-chunk-shift ... -
7483 ;; and now it is calle too often ...
7484 (this-line-indentor-prev (when this-line-indentor-chunk
7485 (overlay-get this-line-indentor-chunk 'mumamo-prev-chunk)))
7486 (this-line-is-indentor (and this-line-indentor-prev
7487 (eq (overlay-get this-line-indentor-prev 'mumamo-next-indent)
7488 'mumamo-template-indentor)
7490 (goto-char (overlay-start this-line-indentor-chunk))
7491 (back-to-indentation)
7492 (= (point) (overlay-start this-line-indentor-chunk)))))
7493 ;; Fix-me: rewrite and reorder. We do not need both shift-in and shift-out
7494 (this-template-shift (when this-line-is-indentor
7495 (mumamo-template-indent-get-chunk-shift this-line-indentor-chunk)))
7496 ;;(dummy (msgtrc "this-line-indentor=%s, %S" this-template-shift this-line-is-indentor))
7497 ;; Fix-me: skip over blank lines backward here:
7498 (prev-template-indentor (when prev-line-chunk0
7499 (unless (eq this-line-chunk0 prev-line-chunk0)
7500 (let* ((prev (overlay-get this-line-chunk0 'mumamo-prev-chunk))
7501 (prev-prev (overlay-get prev 'mumamo-prev-chunk)))
7502 (when (and (eq prev-prev prev-line-chunk0)
7503 (eq (overlay-get prev-prev 'mumamo-next-indent)
7504 'mumamo-template-indentor))
7506 (prev-template-shift-rec (when prev-template-indentor
7507 (mumamo-template-indent-get-chunk-shift prev-template-indentor)
7509 (template-shift (if (and (car this-template-shift) (/= 0 (car this-template-shift)))
7510 (car this-template-shift)
7511 (when prev-template-shift-rec
7512 (cdr prev-template-shift-rec))))
7513 (template-indent-abs (when (and template-shift
7514 (/= 0 template-shift))
7516 (let ((here (point)))
7517 (if prev-template-indentor
7518 (goto-char (overlay-start prev-template-indentor))
7519 (goto-char (overlay-start this-line-indentor-chunk))
7520 (skip-chars-backward " \t\r\n\f"))
7522 (current-indentation)
7523 (goto-char here))))))
7525 (when (and leaving-submode entering-submode)
7526 (message "Do not know how to indent here (both leaving and entering sub chunks)")
7528 ;; Fix-me: indentation
7529 ;;(error "Leaving=%s, entering=%s this0,1,2,3=%s,%s,%s,%s" leaving-submode entering-submode this-line-major0 this-line-major1 this-line-major2 this-line-major3)
7530 (when (or leaving-submode entering-submode)
7531 (unless last-parent-major-indent
7533 ;;(while (and (> 500 (setq while-n1 (1+ while-n1)))
7534 (while (and (mumamo-while 500 'while-n1 "last-parent-major-indent")
7535 (not last-parent-major-indent))
7537 (setq last-parent-major-indent 0)
7538 (goto-char (line-beginning-position 0))
7539 (when (mumamo-fun-eq main-major
7540 (mumamo-chunk-major-mode
7542 (mumamo-indent-current-line-chunks nil)))
7544 (skip-chars-forward " \t")
7546 (setq last-parent-major-indent 0)
7547 (setq last-parent-major-indent (current-column)))))))))
7548 (mumamo-msgindent " leaving-submode=%s, entering-submode=%s" leaving-submode entering-submode)
7549 ;;(msgtrc " leaving-submode=%s, entering-submode=%s, template-indentor=%s" leaving-submode entering-submode template-indentor)
7551 ;; Fix-me: use this.
7552 ;; - clean up after chunk deletion
7553 ;; - next line after a template-indentor, what happens?
7554 ;;(setq template-indentor nil) ;; fix-me
7556 ( template-indent-abs
7557 (setq want-indent (max 0 template-indent-abs)))
7559 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7560 ;;;;; First line after submode
7561 (mumamo-msgindent " leaving last-parent-major-indent=%s" last-parent-major-indent)
7562 (if (eq (overlay-get (overlay-get this-line-chunk0 'mumamo-prev-chunk)
7563 'mumamo-next-indent)
7565 (setq want-indent 0)
7566 (setq want-indent last-parent-major-indent)))
7569 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7570 ;;;;; First line in submode
7571 ;;(setq this-line-indent-major this-line-major0)
7572 (setq this-line-indent-major (mumamo-indent-get-major-to-use this-line-major0 this-depth3))
7573 ;;(when (and prev-line-major0 (not (mumamo-fun-eq this-line-major0 prev-line-major0))) (setq this-line-indent-major prev-line-major0))
7574 (mumamo-msgindent " this-line-indent-major=%s, major-mode=%s this0=%s" this-line-indent-major major-mode this-line-major0)
7575 (mumamo-msgindent " mumamo-submode-indent-offset=%s" mumamo-submode-indent-offset)
7576 (unless (mumamo-fun-eq this-line-indent-major major-mode)
7577 (mumamo-set-major this-line-indent-major this-line-chunk0))
7578 (setq want-indent (+ last-parent-major-indent
7579 (if (= 0 last-parent-major-indent)
7580 (if mumamo-submode-indent-offset-0
7581 mumamo-submode-indent-offset-0
7583 (if mumamo-submode-indent-offset
7584 mumamo-submode-indent-offset
7586 (unless (< 0 want-indent) (setq want-indent nil))
7587 (when (and want-indent (mumamo-indent-use-widen major-mode))
7588 ;; In this case only use want-indent if it is bigger than the
7589 ;; indentation calling indent-line-function would give.
7591 (atomic-change-group
7592 (mumamo-call-indent-line (nth 0 this-line-chunks))
7593 (when (> want-indent (current-indentation))
7594 (signal 'mumamo-error-ind-0 nil))
7595 (setq want-indent nil))
7596 (mumamo-error-ind-0)))
7598 (mumamo-call-indent-line (nth 0 this-line-chunks)))
7599 (mumamo-msgindent " enter sub.want-indent=%s, curr=%s, last-main=%s" want-indent (current-indentation)
7600 last-parent-major-indent)
7601 ;;(unless (> want-indent (current-indentation)) (setq want-indent nil))
7605 ;; We have to change major mode, because we know nothing
7606 ;; about the requirements of the indent-line-function:
7607 ;; Fix-me: This may be cured by RMS suggestion to
7608 ;; temporarily set all variables back to global values?
7609 (setq this-line-indent-major (mumamo-indent-get-major-to-use this-line-major0 this-depth3))
7610 (mumamo-msgindent " this-line-indent-major=%s" this-line-indent-major)
7611 (unless (mumamo-fun-eq this-line-indent-major major-mode) (mumamo-set-major this-line-indent-major this-line-chunk0))
7612 ;; Use the major mode at the beginning of since a sub chunk may
7613 ;; start at start of line.
7614 (if (mumamo-fun-eq this-line-major1 main-major)
7615 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7616 ;;;;; In main major mode
7618 ;; Take care of the case when all the text is in a
7619 ;; sub chunk. In that case use the same indentation as if
7620 ;; the code all belongs to the surrounding major mode.
7621 (let ((here (point))
7622 (use-widen (mumamo-indent-use-widen main-major)))
7623 ;; If we can't indent indent using the main major mode
7624 ;; because it is only blanks and we should not widen,
7625 ;; then use the indentation on the line where it starts.
7626 (mumamo-msgindent " In main major mode")
7628 (skip-chars-backward " \t\n\r\f")
7630 (if (or use-widen (>= (point) (overlay-start this-line-chunk0)))
7633 (mumamo-call-indent-line this-line-chunk0))
7634 (setq want-indent (current-indentation))
7636 (mumamo-msgindent " In main major mode B")
7637 (setq last-parent-major-indent (current-indentation)))
7638 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7639 ;;;;; In sub major mode
7641 ;; Get the indentation the major mode alone would use:
7642 ;;(setq got-indent (mumamo-get-major-mode-indent-column))
7643 ;; Since this line has another major mode than the
7644 ;; previous line we instead want to indent relative to
7645 ;; that line in a way decided in mumamo:
7646 (mumamo-msgindent " In sub major mode")
7647 (let ((chunk (mumamo-get-chunk-save-buffer-state (point)))
7648 (font-lock-dont-widen t)
7651 ind-on-first-sub-line)
7653 (mumamo-update-obscure chunk here)
7654 (let ((syn-min-max (mumamo-chunk-syntax-min-max chunk nil)))
7655 (narrow-to-region (car syn-min-max)
7658 (atomic-change-group
7659 (mumamo-call-indent-line (nth 0 this-line-chunks))
7660 (when (= 0 (current-indentation))
7662 ;; It is maybe ok if indentation on first sub
7663 ;; line is 0 so check that:
7664 (goto-char (point-min))
7666 (setq ind-on-first-sub-line (current-indentation))
7668 (signal 'mumamo-error-ind-0 nil)))
7669 (mumamo-error-ind-0))
7670 ;; Unfortunately the indentation can sometimes get 0
7671 ;; here even though it is clear it should not be 0. This
7672 ;; happens when there are only comments or empty lines
7675 ;; See c:/test/erik-lilja-index.php for an example.
7676 (when ind-zero ;(and t (= 0 (current-indentation)))
7678 (setq want-indent 0)
7679 (unless (= 0 ind-on-first-sub-line)
7680 ;;(while (and (> 500 (setq while-n2 (1+ while-n2)))
7681 (while (and (mumamo-while 500 'while-n2 "want-indent")
7683 (/= (point) (point-min)))
7684 (beginning-of-line 0)
7685 (setq want-indent (current-indentation)))
7686 ;; Now if want-indent is still 0 we need to look further above
7687 (when (= 0 want-indent)
7689 ;;(while (and (> 500 (setq while-n3 (1+ while-n3)))
7690 (while (and (mumamo-while 500 'while-n3 "want-indent 2")
7692 (/= (point) (point-min)))
7693 (beginning-of-line 0)
7694 (setq want-indent (current-indentation)))
7695 ;; If we got to the main major mode we need to add
7696 ;; the special submode offset:
7697 (let* ((ovl (mumamo-get-chunk-save-buffer-state (point)))
7698 (major (mumamo-chunk-major-mode ovl)))
7699 (when (mumamo-fun-eq major main-major)
7700 (setq want-indent (+ want-indent
7701 (if (= 0 want-indent)
7702 mumamo-submode-indent-offset-0
7703 mumamo-submode-indent-offset)))))))))
7706 ;;(msgtrc "indent-line-to %s at line-beginning=%s" want-indent (line-beginning-position))
7707 (indent-line-to want-indent))
7708 ;; (when (and template-shift (/= 0 template-shift))
7709 ;; (let ((ind (+ (current-indentation) template-shift)))
7710 ;; (indent-line-to ind)))
7711 ;; (when template-indent-abs
7712 ;; (indent-line-to template-indent-abs))
7713 (goto-char here-on-line)
7714 ;;(msgtrc "exit: %s" (list this-line-chunks last-parent-major-indent))
7715 (list this-line-chunks last-parent-major-indent next-entering-submode)))
7717 ;; Fix-me: use this for first line in a submode
7718 ;; Fix-me: check more carefully for widen since it may lead to bad results.
7719 (defun mumamo-indent-use-widen (major-mode)
7720 "Return non-nil if widen before indentation in MAJOR-MODE."
7721 (let* ((specials (cadr (assoc major-mode mumamo-indent-widen-per-major)))
7722 (use-widen (memq 'use-widen specials))
7723 (use-widen-maybe (assq 'use-widen specials)))
7725 (memq mumamo-multi-major-mode (cadr use-widen-maybe)))))
7726 ;;(mumamo-indent-use-widen 'php-mode)
7727 ;;(mumamo-indent-use-widen 'nxhtml-mode)
7728 ;;(mumamo-indent-use-widen 'html-mode)
7731 ;; (defun mumamo-indent-special-or-default (default-indent)
7732 ;; "Indent to DEFAULT-INDENT unless a special indent can be done."
7733 ;; (mumamo-with-major-mode-indentation major-mode
7735 ;; (if (mumamo-indent-use-widen major-mode)
7736 ;; (save-restriction
7738 ;; (mumamo-msgindent "=> special-or-default did widen, %s" major-mode)
7739 ;; (funcall indent-line-function))
7740 ;; (indent-to-column default-indent)))))
7742 (defun mumamo-call-indent-line (chunk)
7743 "Call the relevant `indent-line-function'."
7744 ;;(msgtrc "call-indent-line %s, lbp=%s" chunk (line-beginning-position))
7746 (mumamo-with-major-mode-indentation major-mode
7748 (when (mumamo-indent-use-widen major-mode)
7749 (mumamo-msgindent "=> indent-line did widen")
7751 (funcall indent-line-function)))
7752 (let ((maj (car mumamo-major-mode-indent-line-function))
7753 (fun (cdr mumamo-major-mode-indent-line-function)))
7754 (assert (mumamo-fun-eq maj major-mode))
7756 ;; (unless (mumamo-indent-use-widen major-mode)
7757 ;; (let ((syn-min-max (mumamo-chunk-syntax-min-max chunk nil)))
7758 ;; (narrow-to-region (car syn-min-max) (cdr syn-min-max))))
7759 (let ((mumamo-stop-widen (not (mumamo-indent-use-widen major-mode))))
7760 (if (not mumamo-stop-widen)
7762 (let ((syn-min-max (mumamo-chunk-syntax-min-max chunk nil)))
7763 (narrow-to-region (car syn-min-max) (cdr syn-min-max))))
7764 ;;(msgtrc "call-indent-line fun=%s" fun)
7766 ;; Fix-me: Use mumamo-funcall-evaled to avoid (widen):
7767 (mumamo-funcall-evaled fun)
7770 (defvar mumamo-stop-widen nil)
7772 (let* ((fun 'describe-variable)
7773 (lib (symbol-file fun 'defun)))
7774 (find-function-search-for-symbol fun nil lib)))
7776 (defun mumamo-funcall-evaled (fun &rest args)
7777 "Make sure FUN is evaled, then call it.
7778 This make sure (currently) that defadvice for primitives are
7779 called. They are not called in byte compiled code.
7781 See URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=5863' since
7783 (when mumamo-stop-widen
7784 (unless (get fun 'mumamo-evaled)
7785 (let* ((lib (symbol-file fun 'defun))
7786 (where (find-function-search-for-symbol fun nil lib))
7789 (with-current-buffer buf
7790 (let ((close (and (not (buffer-modified-p))
7792 ;;(goto-char pos) (eval-defun nil)
7793 (msgtrc "mumamo-funcall-evaled %s" (current-buffer))
7795 (when close (kill-buffer))))
7796 (put fun 'mumamo-evaled t))))
7797 (apply 'funcall fun args))
7800 (defun mumamo-defadvice-widen ()
7801 (defadvice widen (around
7806 (unless (and mumamo-multi-major-mode
7809 (eval-after-load 'mumamo
7810 '(mumamo-defadvice-widen))
7812 ;; (defadvice font-lock-fontify-buffer (around
7813 ;; mumam-ad-font-lock-fontify-buffer
7817 ;; (if mumamo-multi-major-mode
7818 ;; (save-restriction
7819 ;; (let* ((chunk (mumamo-find-chunks (point) "font-lock-fontify-buffer advice"))
7820 ;; (syn-min-max (mumamo-chunk-syntax-min-max chunk nil))
7821 ;; (syn-min (car syn-min-max))
7822 ;; (syn-max (cdr syn-min-max))
7823 ;; (mumamo-stop-widen t))
7824 ;; (narrow-to-region syn-min syn-max)
7825 ;; (font-lock-fontify-region syn-min syn-max)))
7828 (defun mumamo-indent-region-function (start end)
7829 "Indent the region between START and END."
7831 (setq end (copy-marker end))
7833 (let ((old-point -1)
7835 last-parent-major-indent
7836 entering-submode-arg
7837 ;; Turn off validation during indentation
7838 (old-rng-validate-mode (when (boundp 'rng-validate-mode) rng-validate-mode))
7839 (rng-nxml-auto-validate-flag nil)
7840 (nxhtml-use-imenu nil)
7841 fontification-functions
7842 rng-nxml-auto-validate-flag
7843 (nxhtml-mode-hook (mumamo-get-hook-value
7845 '(html-imenu-setup)))
7848 (when old-rng-validate-mode (rng-validate-mode -1))
7849 ;;(while (and (> 3000 (setq while-n1 (1+ while-n1)))
7850 (while (and (mumamo-while 3000 'while-n1 "indent-region")
7852 (/= old-point (point)))
7853 ;;(message "mumamo-indent-region-function, point=%s" (point))
7854 (or (and (bolp) (eolp))
7855 (let ((ret (mumamo-indent-line-function-1
7857 last-parent-major-indent
7858 entering-submode-arg)))
7859 (setq prev-line-chunks (nth 0 ret))
7860 (setq last-parent-major-indent (nth 1 ret))
7861 (setq entering-submode-arg (nth 2 ret))))
7862 (setq old-point (point))
7864 (when old-rng-validate-mode (rng-validate-mode 1)))
7865 (message "Ready indenting region")))
7868 (defun mumamo-fill-forward-paragraph-function(&optional arg)
7869 "Function to move over paragraphs used by filling code.
7870 This is the buffer local value of
7871 `fill-forward-paragraph-function' when mumamo is used."
7872 ;; fix-me: Do this chunk by chunk
7873 ;; Fix-me: use this (but only in v 23)
7874 (let* ((ovl (mumamo-get-chunk-save-buffer-state (point)))
7875 (major (mumamo-chunk-major-mode ovl)))
7876 (mumamo-with-major-mode-fontification major
7877 fill-forward-paragraph-function)))
7879 (defun mumamo-fill-chunk (&optional justify)
7880 "Fill each of the paragraphs in the current chunk.
7881 Narrow to chunk region trimmed white space at the ends. Then
7884 The argument JUSTIFY is the same as in `fill-region' and a prefix
7885 behaves the same way as there."
7887 (barf-if-buffer-read-only)
7888 (list (if current-prefix-arg 'full))))
7889 (let* ((ovl (mumamo-get-chunk-save-buffer-state (point)))
7890 (major (mumamo-chunk-major-mode ovl)))
7891 ;; Fix-me: There must be some bug that makes it necessary to
7892 ;; always change mode when fill-paragraph-function is
7893 ;; c-fill-paragraph.
7895 ;;(unless (mumamo-fun-eq major major-mode) (mumamo-set-major major ovl))
7896 (mumamo-set-major major ovl)
7899 (mumamo-update-obscure ovl (point))
7900 (let* ((syn-min-max (mumamo-chunk-syntax-min-max ovl nil))
7901 (syn-min (car syn-min-max))
7902 (syn-max (cdr syn-min-max))
7904 (here (point-marker)))
7906 (skip-syntax-forward " ")
7907 ;; Move back over chars that have whitespace syntax but have the p flag.
7908 (backward-prefix-chars)
7909 (setq use-min (point))
7911 (skip-syntax-backward " ")
7912 (fill-region use-min (point) justify)))))
7914 ;; (defvar mumamo-dont-widen)
7915 ;; (defadvice widen (around
7921 ;; "Make `widen' do nothing.
7922 ;; This is for `mumamo-fill-paragraph-function' and is necessary
7923 ;; when `c-fill-paragraph' is the real function used."
7924 ;; (unless (and (boundp 'mumamo-dont-widen)
7925 ;; mumamo-dont-widen)
7928 (defadvice flymake-display-warning (around
7929 mumamo-ad-flymake-display-warning
7932 "Display flymake warnings in the usual Emacs way."
7933 (let ((msg (ad-get-arg 0)))
7934 ;; Fix-me: Can't get backtrace here. Report it.
7935 ;;(setq msg (format (concat msg "\n%S" (with-output-to-string (backtrace)))))
7936 (lwarn '(flymake) :error msg)))
7937 ;;(lwarn '(flymake) :error "the warning")
7939 (defun mumamo-forward-chunk ()
7940 "Move forward to next chunk."
7942 (let* ((chunk (mumamo-get-chunk-save-buffer-state (point)))
7943 (end-pos (overlay-end chunk)))
7944 (goto-char (min end-pos
7947 (defun mumamo-backward-chunk ()
7948 "Move backward to previous chunk."
7950 (let* ((chunk (mumamo-get-chunk-save-buffer-state (point)))
7951 (start-pos (overlay-start chunk)))
7952 (goto-char (max (1- start-pos)
7956 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
7959 (defun mumamo-flyspell-verify ()
7960 "Function used for `flyspell-generic-check-word-predicate'."
7961 (let* ((chunk (when mumamo-multi-major-mode
7962 (mumamo-find-chunks (point) "mumamo-lyspell-verify")))
7963 (chunk-major (when chunk (mumamo-chunk-major-mode chunk)))
7964 (mode-predicate (when chunk-major
7965 (let ((predicate (get chunk-major
7966 'flyspell-mode-predicate)))
7969 (if (mumamo-derived-from-mode chunk-major
7972 'flyspell-generic-progmode-verify)))))
7975 ;; Fix-me: (run-hooks 'flyspell-prog-mode-hook)
7976 (funcall mode-predicate)
7979 ;; (featurep 'cc-engine)
7980 (eval-after-load 'cc-engine
7982 ;; From Alan's mail 2009-12-03: C Mode: acceleration in brace
7984 ;; Fix-me: Should they be here, or...?
7985 (put 'c-state-cache 'permanent-local t)
7986 (put 'c-state-cache-good-pos 'permanent-local t)
7987 (put 'c-state-nonlit-pos-cache 'permanent-local t)
7988 (put 'c-state-nonlit-pos-cache-limit 'permanent-local t)
7989 (put 'c-state-brace-pair-desert 'permanent-local t)
7990 (put 'c-state-point-min 'permanent-local t)
7991 (put 'c-state-point-min-lit-type 'permanent-local t)
7992 (put 'c-state-point-min-lit-start 'permanent-local t)
7993 (put 'c-state-min-scan-pos 'permanent-local t)
7994 (put 'c-state-old-cpp-beg 'permanent-local t)
7995 (put 'c-state-old-cpp-end 'permanent-local t)
7999 ;; Fix-me: Seems perhaps like c-state-point-min-lit-start is reset in
8000 ;; c-state-mark-point-min-literal because c-state-literal-at returns
8001 ;; nil. (Or is (car lit) nil?)
8003 (defvar mumamo-c-state-cache-init nil)
8004 (make-variable-buffer-local 'mumamo-c-state-cache-init)
8005 (put 'mumamo-c-state-cache-init 'permanent-local t)
8007 (defun mumamo-c-state-cache-init ()
8008 (unless mumamo-c-state-cache-init
8009 ;;(msgtrc "c-state-cache-init running")
8010 (setq mumamo-c-state-cache-init t)
8011 (setq c-state-cache (or c-state-cache nil))
8012 (put 'c-state-cache 'permanent-local t)
8013 (setq c-state-cache-good-pos (or c-state-cache-good-pos 1))
8014 (put 'c-state-cache-good-pos 'permanent-local t)
8015 (setq c-state-nonlit-pos-cache (or c-state-nonlit-pos-cache nil))
8016 (put 'c-state-nonlit-pos-cache 'permanent-local t)
8017 (setq c-state-nonlit-pos-cache-limit (or c-state-nonlit-pos-cache-limit 1))
8018 (put 'c-state-nonlit-pos-cache-limit 'permanent-local t)
8019 (setq c-state-brace-pair-desert (or c-state-brace-pair-desert nil))
8020 (put 'c-state-brace-pair-desert 'permanent-local t)
8021 (setq c-state-point-min (or c-state-point-min 1))
8022 (put 'c-state-point-min 'permanent-local t)
8023 (setq c-state-point-min-lit-type (or c-state-point-min-lit-type nil))
8024 (put 'c-state-point-min-lit-type 'permanent-local t)
8025 (setq c-state-point-min-lit-start (or c-state-point-min-lit-start nil))
8026 (put 'c-state-point-min-lit-start 'permanent-local t)
8027 (setq c-state-min-scan-pos (or c-state-min-scan-pos 1))
8028 (put 'c-state-min-scan-pos 'permanent-local t)
8029 (setq c-state-old-cpp-beg (or c-state-old-cpp-beg nil))
8030 (put 'c-state-old-cpp-beg 'permanent-local t)
8031 (setq c-state-old-cpp-end (or c-state-old-cpp-end nil))
8032 (put 'c-state-old-cpp-end 'permanent-local t)
8033 (c-state-mark-point-min-literal)))
8035 (defadvice c-state-cache-init (around
8036 mumamo-ad-c-state-cache-init
8040 (if (not mumamo-multi-major-mode)
8042 (mumamo-c-state-cache-init)))
8044 ;; Fix-me: Have to add per chunk local majors for this one.
8045 (defun mumamo-c-state-literal-at (here)
8046 ;; If position HERE is inside a literal, return (START . END), the
8047 ;; boundaries of the literal (which may be outside the accessible bit of the
8048 ;; buffer). Otherwise, return nil.
8050 ;; This function is almost the same as `c-literal-limits'. It differs in
8051 ;; that it is a lower level function, and that it rigourously follows the
8052 ;; syntax from BOB, whereas `c-literal-limits' uses a "local" safe position.
8053 (let* ((is-here (point))
8054 (s (syntax-ppss here))
8055 (ret (when (or (nth 3 s) (nth 4 s)) ; in a string or comment
8056 (parse-partial-sexp (point) (point-max)
8060 'syntax-table) ; stop at end of literal
8061 (cons (nth 8 s) (point)))))
8065 ;; (save-restriction
8067 ;; (let* ((chunk (mumamo-find-chunks (point) "mumamo-c-state-literal-at"))
8068 ;; (syntax-min-max (mumamo-chunk-syntax-min-max chunk t)))
8069 ;; (narrow-to-region (car syntax-min-max) (cdr syntax-min-max)))
8071 ;; (let ((c c-state-nonlit-pos-cache)
8073 ;; ;; Trim the cache to take account of buffer changes.
8074 ;; (while (and c (> (car c) c-state-nonlit-pos-cache-limit))
8075 ;; (setq c (cdr c)))
8076 ;; (setq c-state-nonlit-pos-cache c)
8078 ;; (while (and c (> (car c) here))
8079 ;; (setq c (cdr c)))
8080 ;; (setq pos (or (car c) (point-min)))
8082 ;; (while (<= (setq npos (+ pos c-state-nonlit-pos-interval))
8084 ;; (setq lit (c-state-pp-to-literal pos npos))
8085 ;; (setq pos (or (cdr lit) npos)) ; end of literal containing npos.
8086 ;; (setq c-state-nonlit-pos-cache (cons pos c-state-nonlit-pos-cache)))
8088 ;; (if (> pos c-state-nonlit-pos-cache-limit)
8089 ;; (setq c-state-nonlit-pos-cache-limit pos))
8091 ;; (setq lit (c-state-pp-to-literal pos here)))
8095 (defadvice c-state-literal-at (around
8096 mumamo-ad-c-state-state-literal-at
8100 (if (not mumamo-multi-major-mode)
8102 (mumamo-c-state-literal-at (ad-get-arg 0))))
8105 (defun mumamo-c-state-get-min-scan-pos ()
8106 ;; Return the lowest valid scanning pos. This will be the end of the
8107 ;; literal enclosing point-min, or point-min itself.
8111 (mumamo-narrow-to-chunk-inner)
8112 (or (and c-state-min-scan-pos
8113 (>= c-state-min-scan-pos (point-min))
8114 c-state-min-scan-pos)
8115 (if (not c-state-point-min-lit-start)
8116 (goto-char (point-min))
8117 (goto-char c-state-point-min-lit-start)
8118 (if (eq c-state-point-min-lit-type 'string)
8120 (forward-comment 1)))
8121 (setq c-state-min-scan-pos (point))))))
8123 (defadvice c-state-get-min-scan-pos (around
8124 mumamo-ad-c-state-get-min-scan-pos-at
8128 (if (not mumamo-multi-major-mode)
8130 (setq ad-return-value (mumamo-c-state-get-min-scan-pos))))
8132 (eval-after-load 'rng-match
8133 ;;; (defun rng-match-init-buffer ()
8134 ;;; (make-local-variable 'rng-compile-table)
8135 ;;; (make-local-variable 'rng-ipattern-table)
8136 ;;; (make-local-variable 'rng-last-ipattern-index))
8138 (put 'rng-compile-table 'permanent-local t)
8139 (put 'rng-ipattern-table 'permanent-local t)
8140 (put 'rng-last-ipattern-index 'permanent-local t)
8143 (eval-after-load 'flyspell
8145 (put 'flyspell-mode 'permanent-local t)
8147 (put 'flyspell-generic-check-word-predicate 'permanent-local t)
8149 (put 'flyspell-casechars-cache 'permanent-local t)
8150 (put 'flyspell-ispell-casechars-cache 'permanent-local t)
8152 (put 'flyspell-not-casechars-cache 'permanent-local t)
8153 (put 'flyspell-ispell-not-casechars-cache 'permanent-local t)
8155 (put 'flyspell-auto-correct-pos 'permanent-local t)
8156 (put 'flyspell-auto-correct-region 'permanent-local t)
8157 (put 'flyspell-auto-correct-ring 'permanent-local t)
8158 (put 'flyspell-auto-correct-word 'permanent-local t)
8160 (put 'flyspell-consider-dash-as-word-delimiter-flag 'permanent-local t)
8162 (put 'flyspell-dash-dictionary 'permanent-local t)
8164 (put 'flyspell-dash-local-dictionary 'permanent-local t)
8166 (put 'flyspell-word-cache-start 'permanent-local t)
8167 (put 'flyspell-word-cache-end 'permanent-local t)
8168 (put 'flyspell-word-cache-word 'permanent-local t)
8169 (put 'flyspell-word-cache-result 'permanent-local t)
8171 (put 'flyspell-word-cache-start 'permanent-local t)
8174 (put 'flyspell-kill-ispell-hook 'permanent-local-hook t)
8175 (put 'flyspell-post-command-hook 'permanent-local-hook t)
8176 (put 'flyspell-pre-command-hook 'permanent-local-hook t)
8177 (put 'flyspell-after-change-function 'permanent-local-hook t)
8178 (put 'flyspell-hack-local-variables-hook 'permanent-local-hook t)
8179 (put 'flyspell-auto-correct-previous-hook 'permanent-local-hook t)
8181 (when mumamo-multi-major-mode
8182 (when (featurep 'flyspell)
8183 (setq flyspell-generic-check-word-predicate 'mumamo-flyspell-verify)))
8186 (defun flyspell-mumamo-mode ()
8187 "Turn on function `flyspell-mode' for multi major modes."
8190 (setq flyspell-generic-check-word-predicate 'mumamo-flyspell-verify)
8192 ;;(run-hooks 'flyspell-prog-mode-hook)
8195 (eval-after-load 'sgml-mode
8197 (put 'sgml-tag-face-alist 'permanent-local t)
8198 (put 'sgml-display-text 'permanent-local t)
8199 (put 'sgml-tag-alist 'permanent-local t)
8200 (put 'sgml-face-tag-alist 'permanent-local t)
8201 (put 'sgml-tag-help 'permanent-local t)
8204 (eval-after-load 'hl-line
8206 (put 'hl-line-overlay 'permanent-local t)
8209 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8210 ;; New versions of syntax-ppss functions, temporary written as defadvice.
8212 (defadvice syntax-ppss-flush-cache (around
8213 mumamo-ad-syntax-ppss-flush-cache
8217 "Support for mumamo.
8218 See the defadvice for `syntax-ppss' for an explanation."
8219 (if (not mumamo-multi-major-mode)
8221 (let ((pos (ad-get-arg 0)))
8222 (let* ((chunk-at-pos (when (and (boundp 'mumamo-multi-major-mode)
8223 mumamo-multi-major-mode)
8224 (mumamo-find-chunks-1 pos "syntax-ppss-flush-cache"))))
8226 (let* ((syntax-ppss-last (overlay-get chunk-at-pos 'syntax-ppss-last))
8227 (syntax-ppss-cache (overlay-get chunk-at-pos 'syntax-ppss-cache)))
8228 ;;(setq ad-return-value ad-do-it)
8230 (overlay-put chunk-at-pos 'syntax-ppss-last syntax-ppss-last)
8231 (overlay-put chunk-at-pos 'syntax-ppss-cache syntax-ppss-cache))
8232 ;;(setq ad-return-value ad-do-it)
8236 (defvar mumamo-syntax-chunk-at-pos nil
8238 (make-variable-buffer-local 'mumamo-syntax-chunk-at-pos)
8240 ;; Fix-me: Is this really needed?
8241 ;; See http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00374.html
8242 (defadvice syntax-ppss-stats (around
8243 mumamo-ad-syntax-ppss-stats
8247 "Support for mumamo.
8248 See the defadvice for `syntax-ppss' for an explanation."
8249 (if mumamo-syntax-chunk-at-pos
8250 (let* ((syntax-ppss-stats
8251 (overlay-get mumamo-syntax-chunk-at-pos 'syntax-ppss-stats)))
8253 (overlay-put mumamo-syntax-chunk-at-pos 'syntax-ppss-stats syntax-ppss-stats))
8256 (defvar mumamo-syntax-ppss-major nil)
8258 ;; FIX-ME: There is a problem with " in xhtml files, especially after
8259 ;; syntax="...". Looks like it is the " entry in
8260 ;; `sgml-font-lock-syntactic-keywords' that is jumping in! Dumping
8261 ;; things in `font-lock-apply-syntactic-highlight' seems to show that.
8263 ;; (I have put in some dump code in my patched version of
8264 ;; Emacs+EmacsW32 there for that. This is commented out by default
8265 ;; and it will only work for the file nxhtml-changes.html which is big
8266 ;; enough for the problem to occur. It happens at point 1109.)
8268 ;; It is this piece of code where the problem arise:
8271 ;; (zerop (car (syntax-ppss (match-beginning 0))))
8272 ;; (goto-char (match-end 0)))
8276 ;; It comes from `sgml-font-lock-syntactic-keywords' in sgml-mode.el
8277 ;; and is supposed to protect from " that is not inside a tag.
8278 ;; However in this case for the second " in syntax="..." `syntax-ppss'
8279 ;; returns 0 as the first element in its return value. That happen
8280 ;; even though `major-mode' is correctly `html-mode'. It leads to
8281 ;; that the property 'syntax with the value (1) is added to the "
8282 ;; after the css-mode chunk in syntax="...". The problem persists
8283 ;; even if the chunk has `fundamental-mode' instead of `css-mode'.
8285 ;; Bypassing the cache for `syntax-pss' by calling
8286 ;; `parse-partial-sexp' directly instead of doing ad-do-it (see
8287 ;; by-pass-chache in the code below) solves the problem for now. It
8288 ;; does not feel like the right solution however.
8290 ;; One way of temporary solving the problem is perhaps to modify
8291 ;; `mumamo-chunk-attr=' to make "" borders, but I am not sure that it
8292 ;; works and it is the wrong solution.
8293 (defadvice syntax-ppss (around
8294 mumamo-ad-syntax-ppss
8298 "Support for mumamo chunks.
8299 For each chunk store as properties of the chunk the parse state
8300 that is normally hold in `syntax-ppss-last' and
8301 `syntax-ppss-cache'.
8303 Compute the beginning parse state for a chunk this way:
8305 - If the chunk major mode is the same as the main major mode for
8306 the multi major mode then parse from the beginning of the file
8307 to the beginning of the chunk using the main major mode. While
8308 doing that jump over chunks that do not belong to the main
8309 major mode and cache the state at the end and beginning of the
8310 the main major mode chunks.
8312 FIX-ME: implement above. Solution?:
8313 (parse-partial-sexp syntax-min (1+ syntax-max) nil nil state-at-syntax-min)
8314 Put this at next chunk's beginning.
8316 - Otherwise set the state at the beginning of the chunk to nil.
8318 Do here also other necessary adjustments for this."
8319 (if (not mumamo-multi-major-mode)
8321 (let ((pos (ad-get-arg 0)))
8322 (unless pos (setq pos (point)))
8323 (let* ((chunk-at-pos (when (and (boundp 'mumamo-multi-major-mode) mumamo-multi-major-mode)
8324 (mumamo-find-chunks-1 pos "syntax-ppss")))
8325 (dump2 (and (boundp 'dump-quote-hunt)
8331 (setq mumamo-syntax-chunk-at-pos chunk-at-pos)
8332 (when dump2 (msgtrc "\npos=%s point-min=%s mumamo-syntax-ppss.chunk-at-pos=%s" pos (point-min) chunk-at-pos))
8334 (let* ((chunk-syntax-min-max (mumamo-chunk-syntax-min-max chunk-at-pos t))
8335 (chunk-syntax-min (car chunk-syntax-min-max))
8336 (chunk-major (mumamo-chunk-major-mode chunk-at-pos))
8337 (syntax-ppss-last (overlay-get chunk-at-pos 'syntax-ppss-last))
8338 (syntax-ppss-cache (overlay-get chunk-at-pos 'syntax-ppss-cache))
8339 (syntax-ppss-last-min (overlay-get chunk-at-pos 'syntax-ppss-last-min))
8340 (syntax-ppss-cache-min (list syntax-ppss-last-min))
8341 ;; This must be fetch the same way as in syntax-ppss:
8342 (syntax-begin-function (overlay-get chunk-at-pos 'syntax-begin-function))
8343 (syntax-ppss-max-span (if chunk-syntax-min
8344 (/ (- pos chunk-syntax-min -2) 2)
8345 syntax-ppss-max-span))
8346 (syntax-ppss-stats (let ((stats (overlay-get chunk-at-pos 'syntax-ppss-stats)))
8349 (default-value 'syntax-ppss-stats))))
8350 (last-min-pos (or (car syntax-ppss-last-min)
8353 ;; If chunk has moved the cached values are invalid.
8354 (unless (= chunk-syntax-min last-min-pos)
8355 (setq syntax-ppss-last nil)
8356 (setq syntax-ppss-last-min nil)
8357 (setq syntax-ppss-cache nil)
8358 (setq syntax-ppss-cache-min nil)
8359 (setq syntax-ppss-stats (default-value 'syntax-ppss-stats)))
8361 (msgtrc " get syntax-ppss-last-min=%s len=%s chunk=%s" syntax-ppss-last-min (length syntax-ppss-last-min) chunk-at-pos)
8362 (msgtrc " prop syntax-ppss-last-min=%s" (overlay-properties chunk-at-pos))
8363 (msgtrc " chunk-major=%s, %s, syntax-min=%s\n last-min=%s" chunk-major major-mode chunk-syntax-min syntax-ppss-last-min))
8365 (when syntax-ppss-last-min
8366 (unless (car syntax-ppss-last-min)
8367 ;;(msgtrc "fix-me: emacs bug workaround, setting car of syntax-ppss-last-min")
8368 ;;(setcar syntax-ppss-last-min (1- chunk-syntax-min))
8369 ;;(msgtrc "fix-me: emacs bug workaround, need new syntax-ppss-last-min because car is nil")
8370 (setq syntax-ppss-last-min nil)
8372 (unless syntax-ppss-last-min
8373 (setq syntax-ppss-last nil)
8376 (let* ((min-pos chunk-syntax-min)
8377 (chunk-sub-major (mumamo-chunk-major-mode chunk-at-pos))
8378 (main-major (mumamo-main-major-mode))
8379 (is-main-mode-chunk (mumamo-fun-eq chunk-sub-major main-major)))
8380 (when dump2 (msgtrc " min-pos=%s, is-main-mode-chunk=%s" min-pos is-main-mode-chunk))
8381 ;; Looks like assert can not be used here for some reason???
8382 ;;(assert (and min-pos) t)
8383 (unless (and min-pos) (error "defadvice syntax-ppss: (and min-pos=%s)" min-pos))
8384 (setq syntax-ppss-last-min
8385 (cons min-pos ;;(1- min-pos)
8386 (if nil ;is-main-mode-chunk
8387 ;; Fix-me: previous chunks as a
8388 ;; cache? The problem is updating
8389 ;; this. Perhaps it is possible to
8390 ;; prune how far back to go by
8391 ;; going to the first chunk
8393 ;; (pars-partial-sexp min max) is
8395 (mumamo-with-major-mode-fontification main-major
8396 `(parse-partial-sexp 1 ,min-pos nil nil nil nil))
8397 (parse-partial-sexp 1 1))))
8398 (setq syntax-ppss-cache-min (list syntax-ppss-last-min))
8399 (when dump2 (msgtrc " put syntax-ppss-last-min=%s len=%s chunk=%s" syntax-ppss-last-min (length syntax-ppss-last-min) chunk-at-pos))
8400 (when dump2 (msgtrc " prop syntax-ppss-last-min=%s" (overlay-properties chunk-at-pos)))
8401 (overlay-put chunk-at-pos 'syntax-ppss-last-min syntax-ppss-last-min)
8402 (let ((test-syntax-ppss-last-min
8403 (overlay-get chunk-at-pos 'syntax-ppss-last-min)))
8404 (when dump2 (msgtrc " test syntax-ppss-last-min=%s len=%s" test-syntax-ppss-last-min (length test-syntax-ppss-last-min)))
8405 (when dump2 (msgtrc " propt syntax-ppss-last-min=%s" (overlay-properties chunk-at-pos)))
8407 (when dump2 (msgtrc " here 0, syntax-ppss-last=%s" syntax-ppss-last))
8408 (unless syntax-ppss-last
8409 (setq syntax-ppss-last syntax-ppss-last-min)
8410 (setq syntax-ppss-cache syntax-ppss-cache-min))
8412 (when dump2 (msgtrc " at 1, syntax-ppss-last=%s" syntax-ppss-last))
8413 (when dump2 (msgtrc " at 1, syntax-ppss-cache=%s" syntax-ppss-cache))
8417 (if (not by-pass-cache)
8420 (let ((old-ppss (cdr syntax-ppss-last))
8421 (old-pos (car syntax-ppss-last)))
8422 ;;(assert (and old-pos pos) t)
8423 (unless (and old-pos pos) (error "defadvice syntax-ppss: (and old-pos=%s pos=%s)" old-pos pos))
8424 (msgtrc "parse-partial-sexp=>%s" (parse-partial-sexp old-pos pos nil nil old-ppss))))
8426 (setq ret-val ad-do-it)))
8427 (let ((old-ppss (cdr syntax-ppss-last))
8428 (old-pos (car syntax-ppss-last)))
8430 (msgtrc "Xparse-partial-sexp %s %s nil nil %s" old-pos pos old-ppss)
8432 (msgtrc "ad-do-it=>%s" ad-do-it)))
8435 ;;(assert (and old-pos pos) t)
8436 (unless (and old-pos pos) (error "defadvice syntax-ppss 2 (and old-pos=%s pos=%s)" old-pos pos))
8438 (msgtrc "parse-partial-sexp %s %s nil nil %s" old-pos pos old-ppss))
8439 (setq ret-val (parse-partial-sexp old-pos pos nil nil old-ppss)))))
8440 (when dump2 (msgtrc " ==>ret-val=%s" ret-val))
8441 ;;(mumamo-backtrace "syntax-ppss")
8442 (setq ad-return-value ret-val))
8443 (overlay-put chunk-at-pos 'syntax-ppss-last syntax-ppss-last)
8444 (overlay-put chunk-at-pos 'syntax-ppss-cache syntax-ppss-cache)
8445 (overlay-put chunk-at-pos 'syntax-ppss-stats syntax-ppss-stats)
8450 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8451 ;;; rng-valid.el support
8453 ;; Fix-me: The solution in this defadvice is temporary. The defadvice
8454 ;; for rng-do-some-validation should be fixed instead.
8455 ;; (ad-disable-advice 'rng-mark-error 'around 'mumamo-ad-rng-mark-error)
8456 ;; (ad-ensable-advice 'rng-mark-error 'around 'mumamo-ad-rng-mark-error)
8457 (defadvice rng-mark-error (around
8458 mumamo-ad-rng-mark-error
8461 "Adjust range for error to chunks."
8462 (if (not mumamo-multi-major-mode)
8464 (let* ((beg (ad-get-arg 1))
8465 (end (ad-get-arg 2))
8467 (chunk (mumamo-find-chunks beg "rng-mark-error")))
8470 (when (and (not (overlay-get chunk 'mumamo-region))
8471 (mumamo-valid-nxml-chunk chunk))
8473 (let ((part-beg (max (overlay-start chunk)
8475 (part-end (min (overlay-end chunk)
8477 (when (< part-beg part-end)
8478 (ad-set-arg 1 part-beg)
8479 (ad-set-arg 2 part-end)
8482 (defadvice rng-do-some-validation-1 (around
8483 mumamo-ad-rng-do-some-validation-1
8486 "Adjust validation to chunks."
8487 (if (not mumamo-multi-major-mode)
8489 (let (major-mode-chunk
8490 (point-max (1+ (buffer-size))) ;(save-restriction (widen) (point-max)))
8491 end-major-mode-chunk
8492 (limit (+ rng-validate-up-to-date-end
8493 rng-validate-chunk-size))
8494 (remove-start rng-validate-up-to-date-end)
8495 (next-cache-point (+ (point) rng-state-cache-distance))
8497 (xmltok-dtd rng-dtd)
8498 have-remaining-chars
8505 xmltok-namespace-attributes
8506 xmltok-dependent-regions
8512 ;;(msgtrc "> > > > > enter rng-do-some-validation-1, continue-p-function=%s" continue-p-function)
8513 (setq have-remaining-chars (< (point) point-max))
8514 (when (and continue (= (point) 1))
8515 (let ((regions (xmltok-forward-prolog)))
8516 (rng-clear-overlays 1 (point))
8518 (when (eq (aref (car regions) 0) 'encoding-name)
8519 (rng-process-encoding-name (aref (car regions) 1)
8520 (aref (car regions) 2)))
8521 (setq regions (cdr regions))))
8522 (unless (equal rng-dtd xmltok-dtd)
8523 (rng-clear-conditional-region))
8524 (setq rng-dtd xmltok-dtd))
8526 (while (and (mumamo-while 2000 'while-n1 "continue")
8527 (/= old-point (point))
8529 (setq old-point (point))
8530 ;; If mumamo (or something similar) is used then jump over parts
8531 ;; that can not be parsed by nxml-mode.
8532 (when (and rng-get-major-mode-chunk-function
8533 rng-valid-nxml-major-mode-chunk-function
8534 rng-end-major-mode-chunk-function)
8535 (let ((here (point))
8537 (skip-chars-forward " \t\r\n")
8538 (setq next-non-space-pos (point))
8540 (unless (and end-major-mode-chunk
8541 ;; Remaining chars in this chunk?
8542 (< next-non-space-pos end-major-mode-chunk))
8543 (setq end-major-mode-chunk nil)
8544 (setq major-mode-chunk (funcall rng-get-major-mode-chunk-function next-non-space-pos "rng-do-some-validation-1 A"))
8546 (while (and (mumamo-while 500 'while-n2 "major-mode-chunk")
8548 (not (funcall rng-valid-nxml-major-mode-chunk-function major-mode-chunk))
8549 (< next-non-space-pos (point-max)))
8550 ;;(msgtrc "next-non-space-pos=%s, cb=%s" next-non-space-pos (current-buffer))
8551 (let ((end-pos (funcall rng-end-major-mode-chunk-function major-mode-chunk)))
8552 ;; fix-me: The problem here is that
8553 ;; mumamo-find-chunks can return a 0-length chunk.
8554 ;;(goto-char (+ end-pos 0))
8555 (goto-char (+ end-pos (if (= end-pos (point)) 1 0)))
8556 (setq major-mode-chunk (funcall rng-get-major-mode-chunk-function (point) "rng-do-some-validation-1 B"))
8557 ;;(message "---> here 3, point=%s, ep=%s, mm-chunk=%s" (point) end-pos major-mode-chunk)
8559 (setq next-non-space-pos (point))))
8560 ;; Stop parsing if we do not have a chunk here yet.
8561 ;;(message "major-mode-chunk=%s" major-mode-chunk)
8562 ;;(message "rng-valid-nxml-major-mode-chunk-function=%s" rng-valid-nxml-major-mode-chunk-function)
8563 (setq continue (and major-mode-chunk
8564 (funcall rng-valid-nxml-major-mode-chunk-function major-mode-chunk)))
8565 ;;(unless continue (message "continue=nil, no major-mode-chunk"))
8567 ;;(message " continue=t")
8568 (setq end-major-mode-chunk (funcall rng-end-major-mode-chunk-function major-mode-chunk)))))
8571 ;; Narrow since rng-forward will continue into next chunk
8572 ;; even if limit is at chunk end.
8575 ;;(message "before rng-forward, point=%s" (point))
8576 (setq have-remaining-chars (rng-forward end-major-mode-chunk))
8577 ;;(message "after rng-forward, point=%s" (point))
8579 ;; Fix-me: Validation does not work when narrowing because
8580 ;; some state variables values seems to be lost. Probably
8581 ;; looking at `rng-validate-prepare' will tell what to do.
8583 (when (and end-major-mode-chunk
8584 (< (point-min) end-major-mode-chunk))
8585 (narrow-to-region (point-min) end-major-mode-chunk))
8586 (setq have-remaining-chars (rng-forward end-major-mode-chunk)))
8587 (unless (> end-major-mode-chunk (point))
8588 ;;(setq have-remaining-chars t)
8589 (goto-char end-major-mode-chunk))
8591 ;;(message "end-major-mode-chunk=%s, rng-validate-up-to-date-end=%s" end-major-mode-chunk rng-validate-up-to-date-end)
8592 (setq have-remaining-chars (< (point) point-max))
8593 ;;(unless have-remaining-chars (message "*** here have-remaining-chars=%s, p=%s/%s" have-remaining-chars (point) point-max))
8594 (let ((pos (point)))
8595 (when end-major-mode-chunk
8596 ;; Fix-me: Seems like we need a new initialization (or why
8597 ;; do we otherwise hang without this?)
8598 (and (> limit end-major-mode-chunk) (setq limit end-major-mode-chunk)))
8600 (and have-remaining-chars
8603 (and continue-p-function
8604 (funcall continue-p-function)
8605 (setq limit (+ limit rng-validate-chunk-size))
8607 ;;(unless continue (message "continue=nil, why?: %s<%s, %s" pos limit (when continue-p-function (funcall continue-p-function))))
8608 (cond ((and rng-conditional-up-to-date-start
8609 ;; > because we are getting the state from (1- pos)
8610 (> pos rng-conditional-up-to-date-start)
8611 (< pos rng-conditional-up-to-date-end)
8612 (rng-state-matches-current (get-text-property (1- pos)
8614 (when (< remove-start (1- pos))
8615 (rng-clear-cached-state remove-start (1- pos)))
8616 ;; sync up with cached validation state
8618 ;; do this before settting rng-validate-up-to-date-end
8619 ;; in case we get a quit
8620 (rng-mark-xmltok-errors)
8621 (rng-mark-xmltok-dependent-regions)
8622 (setq rng-validate-up-to-date-end
8623 (marker-position rng-conditional-up-to-date-end))
8624 (rng-clear-conditional-region)
8625 (setq have-remaining-chars
8626 (< rng-validate-up-to-date-end point-max))
8627 ;;(unless have-remaining-chars (message "have-remaining-chars=%s rng-validate-up-to-date-end=%s, point-max=%s" have-remaining-chars rng-validate-up-to-date-end point-max))
8629 ((or (>= pos next-cache-point)
8631 (setq next-cache-point (+ pos rng-state-cache-distance))
8632 (rng-clear-cached-state remove-start pos)
8633 (when have-remaining-chars
8634 ;;(message "rng-cach-state (1- %s)" pos)
8635 (rng-cache-state (1- pos)))
8636 (setq remove-start pos)
8638 ;; if we have just blank chars skip to the end
8639 (when have-remaining-chars
8640 (skip-chars-forward " \t\r\n")
8641 (when (= (point) point-max)
8642 (rng-clear-overlays pos (point))
8643 (rng-clear-cached-state pos (point))
8644 (setq have-remaining-chars nil)
8645 ;;(message "have-remaining-chars => nil, cause (point) = point-max")
8646 (setq pos (point))))
8647 (when (not have-remaining-chars)
8648 (rng-process-end-document))
8649 (rng-mark-xmltok-errors)
8650 (rng-mark-xmltok-dependent-regions)
8651 (setq rng-validate-up-to-date-end pos)
8652 (when rng-conditional-up-to-date-end
8653 (cond ((<= rng-conditional-up-to-date-end pos)
8654 (rng-clear-conditional-region))
8655 ((< rng-conditional-up-to-date-start pos)
8656 (set-marker rng-conditional-up-to-date-start
8658 ;;(message "--- exit rng-do-some-validation-1, have-remaining-chars=%s" have-remaining-chars)
8659 (setq have-remaining-chars (< (point) point-max))
8660 (setq ad-return-value have-remaining-chars))))
8662 (defadvice rng-after-change-function (around
8663 mumamo-ad-rng-after-change-function
8666 (when rng-validate-up-to-date-end
8669 (defadvice rng-validate-while-idle (around
8670 mumamo-ad-rng-validate-while-idle
8673 (if (not (buffer-live-p buffer))
8677 (defadvice rng-validate-quick-while-idle (around
8678 mumamo-ad-rng-validate-quick-while-idle
8681 (if (not (buffer-live-p buffer))
8685 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8688 ;; (ad-disable-advice 'xmltok-add-error 'around 'mumamo-ad-xmltok-add-error)
8689 ;; (ad-ensable-advice 'xmltok-add-error 'around 'mumamo-ad-xmltok-add-error)
8690 (defadvice xmltok-add-error (around
8691 mumamo-ad-xmltok-add-error
8695 "Prevent rng validation errors in non-xml chunks.
8696 This advice only prevents adding nxml/rng-valid errors in non-xml
8697 chunks. Doing more seems like a very big job - unless Emacs gets
8698 a narrow-to-multiple-regions function!"
8699 (if (not mumamo-multi-major-mode)
8701 ;;(error "xmltok-add-error: %S" (with-output-to-string (backtrace)))
8702 (when (let* ((start (or start xmltok-start))
8703 (end (or end (point)))
8704 (chunk (mumamo-find-chunks (if start start end) "xmltok-add-error"))
8707 (and (not (overlay-get chunk 'mumamo-region))
8708 (mumamo-valid-nxml-chunk chunk))))
8710 (cons (xmltok-make-error message
8711 (or start xmltok-start)
8716 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
8717 ;;; Maybe activate advices
8719 ;; Fix-me: This assumes there are no other advices on these functions.
8722 ;; (ad-activate 'syntax-ppss)
8723 ;; (ad-activate 'syntax-ppss-flush-cache)
8724 ;; (ad-activate 'syntax-ppss-stats)
8725 ;; (ad-activate 'rng-do-some-validation-1)
8726 ;; (ad-activate 'rng-mark-error)
8727 ;; (ad-activate 'xmltok-add-error)
8728 (ad-enable-advice 'syntax-ppss 'around 'mumamo-ad-syntax-ppss)
8729 (ad-enable-advice 'syntax-ppss-flush-cache 'around 'mumamo-ad-syntax-ppss-flush-cache)
8730 (ad-enable-advice 'syntax-ppss-stats 'around 'mumamo-ad-syntax-ppss-stats)
8731 (ad-enable-advice 'rng-do-some-validation-1 'around 'mumamo-ad-rng-do-some-validation-1)
8732 (ad-enable-advice 'rng-mark-error 'around 'mumamo-ad-rng-mark-error)
8733 (ad-enable-advice 'rng-after-change-function 'around 'mumamo-ad-rng-after-change-function)
8734 (ad-enable-advice 'rng-validate-while-idle 'around 'mumamo-ad-rng-validate-while-idle)
8735 (ad-enable-advice 'rng-validate-quick-while-idle 'around 'mumamo-ad-rng-validate-quick-while-idle)
8736 (ad-enable-advice 'xmltok-add-error 'around 'mumamo-ad-xmltok-add-error)
8738 ;; (ad-deactivate 'syntax-ppss)
8739 ;; (ad-deactivate 'syntax-ppss-flush-cache)
8740 ;; (ad-deactivate 'syntax-ppss-stats)
8741 ;; (ad-deactivate 'rng-do-some-validation-1)
8742 ;; (ad-deactivate 'rng-mark-error)
8743 ;; (ad-deactivate 'xmltok-add-error)
8744 (ad-disable-advice 'syntax-ppss 'around 'mumamo-ad-syntax-ppss)
8745 (ad-disable-advice 'syntax-ppss-flush-cache 'around 'mumamo-ad-syntax-ppss-flush-cache)
8746 (ad-disable-advice 'syntax-ppss-stats 'around 'mumamo-ad-syntax-ppss-stats)
8747 (ad-disable-advice 'rng-do-some-validation-1 'around 'mumamo-ad-rng-do-some-validation-1)
8748 (ad-disable-advice 'rng-mark-error 'around 'mumamo-ad-rng-mark-error)
8749 (ad-disable-advice 'rng-after-change-function 'around 'mumamo-ad-rng-after-change-function)
8750 (ad-disable-advice 'rng-validate-while-idle 'around 'mumamo-ad-rng-validate-while-idle)
8751 (ad-disable-advice 'rng-validate-quick-while-idle 'around 'mumamo-ad-rng-validate-quick-while-idle)
8752 (ad-disable-advice 'xmltok-add-error 'around 'mumamo-ad-xmltok-add-error)
8755 (font-lock-add-keywords
8757 '(("\\<define-mumamo-multi-major-mode\\>" . font-lock-keyword-face)))
8761 ;;;;;;;;;;;;;;;;;;;;;;;;;;
8762 ;;; Simple defadvice to move into Emacs later
8764 (defun mumamo-ad-desktop-buffer-info (buffer)
8767 ;; base name of the buffer; replaces the buffer name if managed by uniquify
8768 (and (fboundp 'uniquify-buffer-base-name) (uniquify-buffer-base-name))
8769 ;; basic information
8770 (desktop-file-name (buffer-file-name) desktop-dirname)
8772 (if mumamo-multi-major-mode mumamo-multi-major-mode major-mode)
8776 #'(lambda (minor-mode)
8777 (and (boundp minor-mode)
8778 (symbol-value minor-mode)
8779 (let* ((special (assq minor-mode desktop-minor-mode-table))
8780 (value (cond (special (cadr special))
8781 ((functionp minor-mode) minor-mode))))
8782 (when value (add-to-list 'ret value)))))
8783 (mapcar #'car minor-mode-alist))
8785 ;; point and mark, and read-only status
8787 (list (mark t) mark-active)
8789 ;; auxiliary information
8790 (when (functionp desktop-save-buffer)
8791 (funcall desktop-save-buffer desktop-dirname))
8793 (let ((locals desktop-locals-to-save)
8794 (loclist (buffer-local-variables))
8797 (let ((here (assq (car locals) loclist)))
8799 (setq ll (cons here ll))
8800 (when (member (car locals) loclist)
8801 (setq ll (cons (car locals) ll)))))
8802 (setq locals (cdr locals)))
8805 (defadvice desktop-buffer-info (around
8806 mumamo-ad-desktop-buffer-info
8809 (setq ad-return-value (mumamo-ad-desktop-buffer-info (ad-get-arg 0))))
8811 (defun mumamo-ad-set-auto-mode-0 (mode &optional keep-mode-if-same)
8812 "Apply MODE and return it.
8813 If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of
8814 any aliases and compared to current major mode. If they are the
8815 same, do nothing and return nil."
8816 (unless (and keep-mode-if-same
8817 (eq (indirect-function mode)
8818 (if mumamo-multi-major-mode
8819 (indirect-function mumamo-multi-major-mode)
8820 (indirect-function major-mode))))
8825 (defadvice set-auto-mode-0 (around
8826 mumamo-ad-set-auto-mode-0
8829 (setq ad-return-value (mumamo-ad-set-auto-mode-0 (ad-get-arg 0)
8835 (defvar mumamo-sgml-get-context-last-close nil
8836 "Last close tag start.
8837 Only used for outermost level.")
8839 (defun mumamo-sgml-get-context (&optional until)
8840 "Determine the context of the current position.
8841 By default, parse until we find a start-tag as the first thing on a line.
8842 If UNTIL is `empty', return even if the context is empty (i.e.
8843 we just skipped over some element and got to a beginning of line).
8845 The context is a list of tag-info structures. The last one is the tag
8846 immediately enclosing the current position.
8848 Point is assumed to be outside of any tag. If we discover that it's
8849 not the case, the first tag returned is the one inside which we are."
8850 (let ((here (point))
8856 ;; CONTEXT keeps track of the tag-stack
8857 ;; STACK keeps track of the end tags we've seen (and thus the start-tags
8858 ;; we'll have to ignore) when skipping over matching open..close pairs.
8859 ;; IGNORE is a list of tags that can be ignored because they have been
8860 ;; closed implicitly.
8861 ;; LAST-CLOSE is last close tag that can be useful for indentation
8862 ;; when on outermost level.
8863 (skip-chars-backward " \t\n") ; Make sure we're not at indentation.
8865 (and (not (eq until 'now))
8867 (not (if until (eq until 'empty) context))
8868 (not (sgml-at-indentation-p))
8870 (/= (point) (sgml-tag-start (car context)))
8871 (sgml-unclosed-tag-p (sgml-tag-name (car context)))))
8872 (setq tag-info (ignore-errors (sgml-parse-tag-backward))))
8874 ;; This tag may enclose things we thought were tags. If so,
8877 (> (sgml-tag-end tag-info)
8878 (sgml-tag-end (car context))))
8879 (setq context (cdr context)))
8882 ((> (sgml-tag-end tag-info) here)
8883 ;; Oops!! Looks like we were not outside of any tag, after all.
8884 (push tag-info context)
8888 ((eq (sgml-tag-type tag-info) 'open)
8889 (when (and (null stack)
8891 (setq last-close 'no-use))
8894 (if (assoc-string (sgml-tag-name tag-info) ignore t)
8895 ;; There was an implicit end-tag.
8897 (push tag-info context)
8898 ;; We're changing context so the tags implicitly closed inside
8899 ;; the previous context aren't implicitly closed here any more.
8900 ;; [ Well, actually it depends, but we don't have the info about
8901 ;; when it doesn't and when it does. --Stef ]
8903 ((eq t (compare-strings (sgml-tag-name tag-info) nil nil
8904 (car stack) nil nil t))
8905 (setq stack (cdr stack)))
8907 ;; The open and close tags don't match.
8908 (if (not sgml-xml-mode)
8909 (unless (sgml-unclosed-tag-p (sgml-tag-name tag-info))
8910 (message "Unclosed tag <%s>" (sgml-tag-name tag-info))
8912 ;; We could just assume that the tag is simply not closed
8913 ;; but it's a bad assumption when tags *are* closed but
8914 ;; not properly nested.
8915 (while (and (cdr tmp)
8916 (not (eq t (compare-strings
8917 (sgml-tag-name tag-info) nil nil
8918 (cadr tmp) nil nil t))))
8919 (setq tmp (cdr tmp)))
8920 (if (cdr tmp) (setcdr tmp (cddr tmp)))))
8921 (message "Unmatched tags <%s> and </%s>"
8922 (sgml-tag-name tag-info) (pop stack)))))
8924 (if (and (null stack) (sgml-unclosed-tag-p (sgml-tag-name tag-info)))
8925 ;; This is a top-level open of an implicitly closed tag, so any
8926 ;; occurrence of such an open tag at the same level can be ignored
8927 ;; because it's been implicitly closed.
8928 (push (sgml-tag-name tag-info) ignore)))
8931 ((eq (sgml-tag-type tag-info) 'close)
8932 (if (sgml-empty-tag-p (sgml-tag-name tag-info))
8933 (message "Spurious </%s>: empty tag" (sgml-tag-name tag-info))
8934 ;; Keep track of last close if context will return nil
8935 (when (and (not last-close)
8937 (> here (point-at-eol))
8938 (let ((here (point)))
8939 (goto-char (sgml-tag-start tag-info))
8940 (skip-chars-backward " \t")
8944 (setq last-close tag-info))
8946 (push (sgml-tag-name tag-info) stack)))
8950 (setq mumamo-sgml-get-context-last-close
8951 (when (and last-close
8952 (not (eq last-close 'no-use)))
8953 (sgml-tag-start last-close)))
8956 (defadvice sgml-get-context (around
8957 mumamo-ad-sgml-get-context
8960 (setq ad-return-value (mumamo-sgml-get-context (ad-get-arg 0))))
8962 (defun mumamo-sgml-calculate-indent (&optional lcon)
8963 "Calculate the column to which this line should be indented.
8964 LCON is the lexical context, if any."
8965 (unless lcon (setq lcon (sgml-lexical-context)))
8967 ;; Indent comment-start markers inside <!-- just like comment-end markers.
8968 (if (and (eq (car lcon) 'tag)
8970 (save-excursion (goto-char (cdr lcon)) (looking-at "<!--")))
8971 (setq lcon (cons 'comment (+ (cdr lcon) 2))))
8976 ;; Go back to previous non-empty line.
8977 (while (and (> (point) (cdr lcon))
8978 (zerop (forward-line -1))
8979 (looking-at "[ \t]*$")))
8980 (if (> (point) (cdr lcon))
8981 ;; Previous line is inside the string.
8982 (current-indentation)
8983 (goto-char (cdr lcon))
8984 (1+ (current-column))))
8987 (let ((mark (looking-at "--")))
8988 ;; Go back to previous non-empty line.
8989 (while (and (> (point) (cdr lcon))
8990 (zerop (forward-line -1))
8991 (or (looking-at "[ \t]*$")
8992 (if mark (not (looking-at "[ \t]*--"))))))
8993 (if (> (point) (cdr lcon))
8994 ;; Previous line is inside the comment.
8995 (skip-chars-forward " \t")
8996 (goto-char (cdr lcon))
8997 ;; Skip `<!' to get to the `--' with which we want to align.
8998 (search-forward "--")
8999 (goto-char (match-beginning 0)))
9000 (when (and (not mark) (looking-at "--"))
9001 (forward-char 2) (skip-chars-forward " \t"))
9004 ;; We don't know how to indent it. Let's be honest about it.
9006 ;; We don't know how to indent it. Let's be honest about it.
9010 (goto-char (1+ (cdr lcon)))
9011 (skip-chars-forward "^ \t\n") ;Skip tag name.
9012 (skip-chars-forward " \t")
9015 ;; This is the first attribute: indent.
9016 (goto-char (1+ (cdr lcon)))
9017 (+ (current-column) sgml-basic-offset)))
9020 (while (looking-at "</")
9022 (skip-chars-forward " \t"))
9023 (let* ((here (point))
9024 (unclosed (and ;; (not sgml-xml-mode)
9025 (looking-at sgml-tag-name-re)
9026 (assoc-string (match-string 1)
9027 sgml-unclosed-tags 'ignore-case)
9030 ;; If possible, align on the previous non-empty text line.
9031 ;; Otherwise, do a more serious parsing to find the
9032 ;; tag(s) relative to which we should be indenting.
9033 (if (and (not unclosed) (skip-chars-backward " \t")
9034 (< (skip-chars-backward " \t\n") 0)
9035 (back-to-indentation)
9036 (> (point) (cdr lcon)))
9039 (nreverse (sgml-get-context (if unclosed nil 'empty)))))
9041 ;; Ignore previous unclosed start-tag in context.
9042 (while (and context unclosed
9043 (eq t (compare-strings
9044 (sgml-tag-name (car context)) nil nil
9045 unclosed nil nil t)))
9046 (setq context (cdr context)))
9047 ;; Indent to reflect nesting.
9049 ;; If we were not in a text context after all, let's try again.
9050 ((and context (> (sgml-tag-end (car context)) here))
9052 (sgml-calculate-indent
9053 (cons (if (memq (sgml-tag-type (car context)) '(comment cdata))
9054 (sgml-tag-type (car context)) 'tag)
9055 (sgml-tag-start (car context)))))
9056 ;; Align on the first element after the nearest open-tag, if any.
9058 (goto-char (sgml-tag-end (car context)))
9059 (skip-chars-forward " \t\n")
9060 (< (point) here) (sgml-at-indentation-p))
9063 (goto-char (or (and (null context)
9064 mumamo-sgml-get-context-last-close)
9067 (* sgml-basic-offset (length context)))))))
9070 (error "Unrecognized context %s" (car lcon)))
9074 (defadvice sgml-calculate-indent (around
9075 mumamo-ad-sgml-calculate-indent
9078 (setq ad-return-value (mumamo-sgml-calculate-indent (ad-get-arg 0))))
9080 (defadvice python-eldoc-function (around
9081 mumamo-ad-python-eldoc-function
9084 (if (not mumamo-multi-major-mode)
9086 (let ((here (point)))
9089 (mumamo-narrow-to-chunk-inner)
9091 (goto-char here)))))
9093 ;;;;;;;;;;;;;;;;;;;;;;;;;;
9095 ;;(when buffer-file-name (message "Finished evaluating %s" buffer-file-name))
9096 ;;(when load-file-name (message "Finished loading %s" load-file-name))
9099 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
9100 ;;; mumamo.el ends bere