From 94d2fc1815a919734353c942f224db1de4b4fcb8 Mon Sep 17 00:00:00 2001
From: Tom Willemsen
Date: Mon, 7 Mar 2011 09:04:49 +0100
Subject: Django, org
* Added nxhtml, mostly for django support.
* Changed some org settings.
---
emacs.d/nxhtml/util/mumamo.el | 9100 +++++++++++++++++++++++++++++++++++++++++
1 file changed, 9100 insertions(+)
create mode 100644 emacs.d/nxhtml/util/mumamo.el
(limited to 'emacs.d/nxhtml/util/mumamo.el')
diff --git a/emacs.d/nxhtml/util/mumamo.el b/emacs.d/nxhtml/util/mumamo.el
new file mode 100644
index 0000000..3fefa1a
--- /dev/null
+++ b/emacs.d/nxhtml/util/mumamo.el
@@ -0,0 +1,9100 @@
+;;; mumamo.el --- Multiple major modes in a buffer
+;;
+;; Author: Lennart Borgman (lennart O borgman A gmail O com)
+;; Maintainer:
+;; Created: Fri Mar 09 2007
+(defconst mumamo:version "0.91") ;;Version:
+;; Last-Updated: 2009-10-19 Mon
+;; URL: http://OurComments.org/Emacs/Emacs.html
+;; Keywords:
+;; Compatibility:
+;;
+;; Features that might be required by this library:
+;;
+;; `appmenu', `apropos', `backquote', `button', `bytecomp', `cl',
+;; `comint', `compile', `easymenu', `flyspell', `grep', `ido',
+;; `ispell', `mail-prsvr', `mlinks', `mm-util', `nxml-enc',
+;; `nxml-glyph', `nxml-mode', `nxml-ns', `nxml-outln',
+;; `nxml-parse', `nxml-rap', `nxml-util', `ourcomments-util',
+;; `recentf', `ring', `rng-dt', `rng-loc', `rng-match',
+;; `rng-parse', `rng-pttrn', `rng-uri', `rng-util', `rng-valid',
+;; `rx', `sgml-mode', `timer', `tool-bar', `tree-widget',
+;; `url-expand', `url-methods', `url-parse', `url-util',
+;; `url-vars', `wid-edit', `xmltok'.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+;;
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING. If not, write to the
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; Commentary:
+;;
+;; In some cases you may find that it is quite hard to write one major
+;; mode that does everything for the type of file you want to handle.
+;; That is the case for example for a PHP file where there comes
+;; useful major modes with Emacs for the html parts, and where you can
+;; get a major mode for PHP from other sources (see EmacsWiki for
+;; Aaron Hawleys php-mode.el, or the very similar version that comes
+;; with nXhtml).
+;;
+;; Using one major mode for the HTML part and another for the PHP part
+;; sounds like a good solution. But this means you want to use (at
+;; least) two major modes in the same buffer.
+;;
+;; This file implements just that, support for MUltiple MAjor MOdes
+;; (mumamo) in a buffer.
+;;
+;;
+;;;; Usage:
+;;
+;; The multiple major mode support is turned on by calling special
+;; functions which are used nearly the same way as major modes. See
+;; `mumamo-defined-multi-major-modes' for more information about those
+;; functions.
+;;
+;; Each such function defines how to take care of a certain mix of
+;; major functions in the buffer. We call them "multi major modes".
+;;
+;; You may call those functions directly (like you can with major mode
+;; functions) or you may use them in for example `auto-mode-alist'.
+;;
+;; You can load mumamo in your .emacs with
+;;
+;; (require 'mumamo-fun)
+;;
+;; or you can generate an autoload file from mumamo-fun.el
+;;
+;; Note that no multi major mode functions are defined in this file.
+;; Together with this file comes the file mumamo-fun.el that defines
+;; some such functions. All those functions defined in that file are
+;; marked for autoload.
+;;
+;;
+;;
+;; Thanks to Stefan Monnier for beeing a good and knowledgeable
+;; speaking partner for some difficult parts while I was trying to
+;; develop this.
+;;
+;; Thanks to RMS for giving me support and ideas about the programming
+;; interface. That simplified the code and usage quite a lot.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; How to add support for a new mix of major modes
+;;
+;; This is done by creating a new function using
+;; `define-mumamo-multi-major-mode'. See that function for more
+;; information.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; Information for major mode authors
+;;
+;; There are a few special requirements on major modes to make them
+;; work with mumamo:
+;;
+;; - fontification-functions should be '(jit-lock-function). However
+;; nxml-mode derivates can work too, see the code for more info.
+;;
+;; - narrowing should be respected during fontification and
+;; indentation when font-lock-dont-widen is non-nil.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; Information for minor mode authors
+;;
+;; Some minor modes are written to be specific for the file edited in
+;; the buffer and some are written to be specific for a major
+;; modes. Others are emulating another editor. Those are probably
+;; global, but might still have buffer local values.
+;;
+;; Those minor modes that are not meant to be specific for a major
+;; mode should probably survive changing major mode in the
+;; buffer. That is mostly not the case in Emacs today.
+;;
+;; There are (at least) two type of values for those minor modes that
+;; sometimes should survive changing major mode: buffer local
+;; variables and functions added locally to hooks.
+;;
+;; * Some buffer local variables are really that - buffer local. Other
+;; are really meant not for the buffer but for the major mode or
+;; some minor mode that is local to the buffer.
+;;
+;; If the buffer local variable is meant for the buffer then it is
+;; easy to make them survive changing major mode: just add
+;;
+;; (put 'VARIABLE 'permanent-local t)
+;;
+;; to those variables. That will work regardless of the way major
+;; mode is changed.
+;;
+;; If one only wants the variables to survive the major mode change
+;; that is done when moving between chunks with different major
+;; modes then something different must be used. To make a variable
+;; survive this, but not a major mode change for the whole buffer,
+;; call any the function `mumamo-make-variable-buffer-permanent':
+;;
+;; (mumamo-make-variable-buffer-permanent 'VARIABLE)
+;;
+;; * For functions entered to local hooks use this
+;;
+;; (put 'FUNSYM 'permanent-local-hook t)
+;; (add-hook 'HOOKSYM 'FUNSYM nil t)
+;;
+;; where HOOKSYM is the hook and FUNSYM is the function.
+;;
+;; * Some functions that are run in `change-major-mode' and dito
+;; after- must be avoided when mumamo changes major mode. The
+;; functions to avoid should be listed in
+;;
+;; `mumamo-change-major-mode-no-nos'
+;; `mumamo-after-change-major-mode-no-nos'
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; Comments on code etc:
+;;
+;; This is yet another way to try to get different major modes for
+;; different chunks of a buffer to work. (I borrowed the term "chunk"
+;; here from multi-mode.el.) I am aware of two main previous elisp
+;; packages that tries to do this, multi-mode.el and mmm-mode.el.
+;; (See http://www.emacswiki.org/cgi-bin/wiki/MultipleModes where
+;; there are also some other packages mentioned.) The solutions in
+;; those are a bit different from the approach here.
+;;
+;; The idea of doing it the way mumamo does it is of course based on a
+;; hope that switching major mode when moving between chunks should be
+;; quick. I found that it took from 0 - 62 000 ms, typically 0 - 16
+;; 000 ms on a 3ghz cpu. However unfortunately this is not the whole
+;; truth. It could take longer time, depending on what is run in the
+;; hooks: The major mode specific hook, `after-change-major-mode-hook'
+;; and `change-major-mode-hook'.
+;;
+;; Because it currently may take long enough time switching major mode
+;; when moving between chunks to disturb smooth moving around in the
+;; buffer I have added a way to let the major mode switching be done
+;; after moving when Emacs is idle. This is currently the default, but
+;; see the custom variable `mumamo-set-major-mode-delay'.
+;;
+;; Since the intention is to set up the new major mode the same way as
+;; it should have been done if this was a major mode for the whole
+;; buffer these hooks must be run. However if this idea is developed
+;; further some of the things done in these hooks (like switching on
+;; minor modes) could perhaps be streamlined so that switching minor
+;; modes off and then on again could be avoided. In fact there is
+;; already tools for this in mumamo.el, see the section below named
+;; "Information for minor mode authors".
+;;
+;; Another problem is that the major modes must use
+;; `font-lock-fontify-region-function'. Currently the only major
+;; modes I know that does not do this are `nxml-mode' and its
+;; derivatives.
+;;
+;; The indentation is currently working rather ok, but with the price
+;; that buffer modified is sometimes set even though there are no
+;; actual changes. That seems a bit unnecessary and it could be
+;; avoided if the indentation functions for the the various major
+;; modes were rewritten so that you could get the indentation that
+;; would be done instead of actually doing the indentation. (Or
+;; mumamo could do this better, but I do not know how right now.)
+;;
+;; See also "Known bugs and problems etc" below.
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; Known bugs:
+;;
+;; - See the various FIX-ME for possible bugs. See also below.
+;;
+;;
+;;;; Known problems and ideas:
+;;
+;; - There is no way in Emacs to tell a mode not to change
+;; fontification when changing to or from that mode.
+;;
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; Change log:
+;;
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;;;; Code:
+
+(eval-when-compile (require 'cl))
+(eval-when-compile (require 'cc-engine))
+(eval-when-compile (require 'desktop))
+(eval-when-compile (require 'flyspell))
+(eval-when-compile (require 'rngalt nil t))
+(eval-when-compile (require 'nxml-mode nil t))
+(eval-when-compile
+ (when (featurep 'nxml-mode)
+ (require 'rng-valid nil t)
+ ;;(require 'rngalt nil t)
+ ))
+(eval-when-compile (require 'sgml-mode)) ;; For sgml-xml-mode
+;; For `define-globalized-minor-mode-with-on-off':
+;;(require 'ourcomments-util)
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; rng-valid.el support
+
+(defvar rng-get-major-mode-chunk-function nil
+ "Function to use to get major mode chunk.
+It should take one argument, the position where to get the major
+mode chunk.
+
+This is to be set by multiple major mode frame works, like
+mumamo.
+
+See also `rng-valid-nxml-major-mode-chunk-function' and
+`rng-end-major-mode-chunk-function'. Note that all three
+variables must be set.")
+(make-variable-buffer-local 'rng-get-major-mode-chunk-function)
+(put 'rng-get-major-mode-chunk-function 'permanent-local t)
+
+(defvar rng-valid-nxml-major-mode-chunk-function nil
+ "Function to use to check if nxml can parse major mode chunk.
+It should take one argument, the chunk.
+
+For more info see also `rng-get-major-mode-chunk-function'.")
+(make-variable-buffer-local 'rng-valid-nxml-major-mode-chunk-function)
+(put 'rng-valid-nxml-major-mode-chunk-function 'permanent-local t)
+
+(defvar rng-end-major-mode-chunk-function nil
+ "Function to use to get the end of a major mode chunk.
+It should take one argument, the chunk.
+
+For more info see also `rng-get-major-mode-chunk-function'.")
+(make-variable-buffer-local 'rng-end-major-mode-chunk-function)
+(put 'rng-end-major-mode-chunk-function 'permanent-local t)
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Some variables
+
+(defvar mumamo-major-mode-indent-line-function nil)
+(make-variable-buffer-local 'mumamo-major-mode-indent-line-function)
+
+(defvar mumamo-buffer-locals-per-major nil)
+(make-variable-buffer-local 'mumamo-buffer-locals-per-major)
+(put 'mumamo-buffer-locals-per-major 'permanent-local t)
+
+(defvar mumamo-just-changed-major nil
+ "Avoid refontification when switching major mode.
+Set to t by `mumamo-set-major'. Checked and reset to nil by
+`mumamo-jit-lock-function'.")
+(make-variable-buffer-local 'mumamo-just-changed-major)
+
+(defvar mumamo-multi-major-mode nil
+ "The function that handles multiple major modes.
+If this is nil then multiple major modes in the buffer is not
+handled by mumamo.
+
+Set by functions defined by `define-mumamo-multi-major-mode'.")
+(make-variable-buffer-local 'mumamo-multi-major-mode)
+(put 'mumamo-multi-major-mode 'permanent-local t)
+
+(defvar mumamo-set-major-running nil
+ "Internal use. Handling of mumamo turn off.")
+
+(defun mumamo-chunk-car (chunk prop)
+ (car (overlay-get chunk prop)))
+
+(defun mumamo-chunk-cadr (chunk prop)
+ (cadr (overlay-get chunk prop)))
+
+;; (let ((l '(1 2))) (setcar (nthcdr 1 l) 10) l)
+;; setters
+(defsubst mumamo-chunk-value-set-min (chunk-values min)
+ "In CHUNK-VALUES set min value to MIN.
+CHUNK-VALUES should have the format return by
+`mumamo-create-chunk-values-at'."
+ (setcar (nthcdr 0 chunk-values) min))
+(defsubst mumamo-chunk-value-set-max (chunk-values max)
+ "In CHUNK-VALUES set max value to MAX.
+See also `mumamo-chunk-value-set-min'."
+ (setcar (nthcdr 1 chunk-values) max))
+(defsubst mumamo-chunk-value-set-syntax-min (chunk-values min)
+ "In CHUNK-VALUES set min syntax diff value to MIN.
+See also `mumamo-chunk-value-set-min'."
+ (setcar (nthcdr 3 chunk-values) min))
+(defsubst mumamo-chunk-value-set-syntax-max (chunk-values max)
+ "In CHUNK-VALUES set max syntax diff value to MAX.
+See also `mumamo-chunk-value-set-min'."
+ (setcar (nthcdr 3 chunk-values) max))
+;; getters
+(defsubst mumamo-chunk-value-min (chunk-values)
+ "Get min value from CHUNK-VALUES.
+See also `mumamo-chunk-value-set-min'."
+ (nth 0 chunk-values))
+(defsubst mumamo-chunk-value-max (chunk-values)
+ "Get max value from CHUNK-VALUES.
+See also `mumamo-chunk-value-set-min'."
+ (nth 1 chunk-values))
+(defsubst mumamo-chunk-value-major (chunk-values)
+ "Get major value from CHUNK-VALUES.
+See also `mumamo-chunk-value-set-min'."
+ (nth 2 chunk-values))
+(defsubst mumamo-chunk-value-syntax-min (chunk-values)
+ "Get min syntax diff value from CHUNK-VALUES.
+See also `mumamo-chunk-value-set-min'."
+ (nth 3 chunk-values))
+(defsubst mumamo-chunk-value-syntax-max (chunk-values)
+ "Get max syntax diff value from CHUNK-VALUES.
+See also `mumamo-chunk-value-set-min'."
+ (nth 4 chunk-values))
+(defsubst mumamo-chunk-value-parseable-by (chunk-values)
+ "Get parseable-by from CHUNK-VALUES.
+See also `mumamo-chunk-value-set-min'.
+For parseable-by see `mumamo-find-possible-chunk'."
+ (nth 5 chunk-values))
+;; (defsubst mumamo-chunk-prev-chunk (chunk-values)
+;; "Get previous chunk from CHUNK-VALUES.
+;; See also `mumamo-chunk-value-set-min'."
+;; (nth 6 chunk-values))
+(defsubst mumamo-chunk-value-fw-exc-fun (chunk-values)
+ "Get function that find chunk end from CHUNK-VALUES.
+See also `mumamo-chunk-value-set-min'."
+ (nth 6 chunk-values))
+
+(defsubst mumamo-chunk-major-mode (chunk)
+ "Get major mode specified in CHUNK."
+ ;;(assert chunk)
+ ;;(assert (overlay-buffer chunk))
+ (let ((mode-spec (if chunk
+ (mumamo-chunk-car chunk 'mumamo-major-mode)
+ (mumamo-main-major-mode))))
+ (mumamo-major-mode-from-modespec mode-spec)))
+
+(defsubst mumamo-chunk-syntax-min-max (chunk no-obscure)
+ (when chunk
+ (let* ((ovl-end (overlay-end chunk))
+ (ovl-start (overlay-start chunk))
+ (syntax-min (min ovl-end
+ (+ ovl-start
+ (or (overlay-get chunk 'mumamo-syntax-min-d)
+ 0))))
+ ;;(dummy (msgtrc "chunk-syntax-min-max:syntax-min=%s, chunk=%S" syntax-min chunk))
+ (syntax-max
+ (max ovl-start
+ (- (overlay-end chunk)
+ (or (overlay-get chunk 'mumamo-syntax-max-d)
+ 0)
+ (if (= (1+ (buffer-size))
+ (overlay-end chunk))
+ 0
+ ;; Note: We must subtract one here because
+ ;; overlay-end is +1 from the last point in the
+ ;; overlay.
+ ;;
+ ;; This cured the problem with
+ ;; kubica-freezing-i.html that made Emacs loop
+ ;; in `font-lock-extend-region-multiline'. But
+ ;; was it really this one, I can't find any
+ ;; 'font-lock-multiline property. So it should
+ ;; be `font-lock-extend-region-whole-lines'.
+ ;;
+ ;; Should not the problem then be the value of font-lock-end?
+ ;;
+ ;; Fix-me: however this is not correct since it
+ ;; leads to not fontifying the last character in
+ ;; the chunk, see bug 531324.
+ ;;
+ ;; I think this is cured by now. I have let
+ ;; bound `font-lock-extend-region-functions'
+ ;; once more before the call to
+ ;; `font-lock-fontify-region'.
+ 0
+ ;;0
+ ))))
+ (obscure (unless no-obscure (overlay-get chunk 'obscured)))
+ (region-info (cadr obscure))
+ (obscure-min (car region-info))
+ (obscure-max (cdr region-info))
+ ;;(dummy (message "syn-mn-mx:obs=%s r-info=%s ob=%s/%s" obscure region-info obscure-min obscure-max ))
+ (actual-min (max (or obscure-min ovl-start)
+ (or syntax-min ovl-start)))
+ (actual-max (min (or obscure-max ovl-end)
+ (or syntax-max ovl-end)))
+ (maj (mumamo-chunk-car chunk 'mumamo-major-mode))
+ ;;(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))
+ )
+ (cons actual-min actual-max))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Macros
+
+;; Borrowed from font-lock.el
+(defmacro mumamo-save-buffer-state (varlist &rest body)
+ "Bind variables according to VARLIST and eval BODY restoring buffer state.
+Do not record undo information during evaluation of BODY."
+ (declare (indent 1) (debug let))
+ (let ((modified (make-symbol "modified")))
+ `(let* ,(append varlist
+ `((,modified (buffer-modified-p))
+ (buffer-undo-list t)
+ (inhibit-read-only t)
+ (inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t)
+ deactivate-mark
+ buffer-file-name
+ buffer-file-truename))
+ (progn
+ ,@body)
+ (unless ,modified
+ (restore-buffer-modified-p nil)))))
+
+;; From jit-lock.el:
+(defmacro mumamo-jit-with-buffer-unmodified (&rest body)
+ "Eval BODY, preserving the current buffer's modified state."
+ (declare (debug t))
+ (let ((modified (make-symbol "modified")))
+ `(let ((,modified (buffer-modified-p)))
+ (unwind-protect
+ (progn ,@body)
+ (unless ,modified
+ (restore-buffer-modified-p nil))))))
+
+(defmacro mumamo-with-buffer-prepared-for-jit-lock (&rest body)
+ "Execute BODY in current buffer, overriding several variables.
+Preserves the `buffer-modified-p' state of the current buffer."
+ (declare (debug t))
+ `(mumamo-jit-with-buffer-unmodified
+ (let ((buffer-undo-list t)
+ (inhibit-read-only t)
+ (inhibit-point-motion-hooks t)
+ (inhibit-modification-hooks t)
+ deactivate-mark
+ buffer-file-name
+ buffer-file-truename)
+ ,@body)))
+
+(defmacro mumamo-condition-case (var body-form &rest handlers)
+ "Like `condition-case', but optional.
+If `mumamo-use-condition-case' is non-nil then do
+
+ (condition-case VAR
+ BODY-FORM
+ HANDLERS).
+
+Otherwise just evaluate BODY-FORM."
+ (declare (indent 2) (debug t))
+ `(if (not mumamo-use-condition-case)
+ (let* ((debugger (or mumamo-debugger 'debug))
+ (debug-on-error (if debugger t debug-on-error)))
+ ,body-form)
+ (condition-case ,var
+ ,body-form
+ ,@handlers)))
+
+(defmacro mumamo-msgfntfy (format-string &rest args)
+ "Give some messages during fontification.
+This macro should just do nothing during normal use. However if
+there are any problems you can uncomment one of the lines in this
+macro and recompile/reeval mumamo.el to get those messages.
+
+You have to search the code to see where you will get them. All
+uses are in this file.
+
+FORMAT-STRING and ARGS have the same meaning as for the function
+`message'."
+ ;;(list 'apply (list 'quote 'msgtrc) format-string (append '(list) args))
+ ;;(list 'apply (list 'quote 'message) format-string (append '(list) args))
+ ;;(list 'progn 'apply (list 'quote 'message) format-string (append '(list) args) nil)
+ ;; (condition-case err
+ ;; (list 'apply (list 'quote 'message) format-string (append '(list) args)) ;; <--
+ ;; (error (message "err in msgfntfy %S" err)))
+ ;;(message "%s %S" format-string args)
+ ;;(list 'apply (list 'quote 'message) (list 'concat "%s: " format-string)
+ ;; (list 'get-internal-run-time) (append '(list) args))
+ )
+;;(mumamo-msgfntfy "my-format=%s" (get-internal-run-time))
+
+(defmacro mumamo-msgindent (format-string &rest args)
+ "Give some messages during indentation.
+This macro should just do nothing during normal use. However if
+there are any problems you can uncomment one of the lines in this
+macro and recompile/reeval mumamo.el to get those messages.
+
+You have to search the code to see where you will get them. All
+uses are in this file.
+
+FORMAT-STRING and ARGS have the same meaning as for the function
+`message'."
+ ;;(list 'apply (list 'quote 'msgtrc) format-string (append '(list) args))
+ ;;(list 'apply (list 'quote 'message) format-string (append '(list) args)) ;; <---
+ ;;(list 'apply (list 'quote 'message) (list 'concat "%s: " format-string)
+ ;; (list 'get-internal-run-time) (append '(list) args))
+ )
+
+(defmacro mumamo-with-major-mode-setup (major for-what &rest body)
+ "Run code with some local variables set as in specified major mode.
+Set variables as needed for major mode MAJOR when doing FOR-WHAT
+and then run BODY using `with-syntax-table'.
+
+FOR-WHAT is used to choose another major mode than MAJOR in
+certain cases. It should be 'fontification or 'indentation.
+
+Note: We must let-bind the variables here instead of make them buffer
+local since they otherwise could be wrong at \(point) in top
+level \(ie user interaction level)."
+ (declare (indent 2) (debug t))
+ `(let ((need-major-mode (mumamo-get-major-mode-substitute ,major ,for-what)))
+ ;;(msgtrc "mumamo-with-major-mode-setup %s => %s, modified=%s" ,major need-major-mode (buffer-modified-p))
+ ;;(msgtrc "with-major-mode-setup <<<<<<<<<< body=%S\n>>>>>>>>>>" '(progn ,@body))
+ ;;(msgtrc "with-major-mode-setup:in buffer %s after-chunk=%s" (current-buffer) (when (boundp 'after-chunk) after-chunk))
+ (let ((major-mode need-major-mode)
+ (evaled-set-mode (mumamo-get-major-mode-setup need-major-mode)))
+ ;;(message ">>>>>> before %s" evaled-set-mode)
+ ;;(message ">>>>>> before %s, body=%s" evaled-set-mode (list ,@body))
+ (funcall (symbol-value evaled-set-mode)
+ (list 'progn
+ ,@body))
+ ;;(mumamo-msgfntfy "<<<<<< after evaled-set-mode modified=%s" (buffer-modified-p))
+ )))
+
+(defmacro mumamo-with-major-mode-fontification (major &rest body)
+ "With fontification variables set as major mode MAJOR eval BODY.
+This is used during font locking and indentation. The variables
+affecting those are set as they are in major mode MAJOR.
+
+See the code in `mumamo-fetch-major-mode-setup' for exactly which
+local variables that are set."
+ (declare (indent 1) (debug t))
+ `(mumamo-with-major-mode-setup ,major 'fontification
+ ,@body))
+;; Fontification disappears in for example *grep* if
+;; font-lock-mode-major-mode is 'permanent-local t.
+;;(put 'font-lock-mode-major-mode 'permanent-local t)
+
+(defmacro mumamo-with-major-mode-indentation (major &rest body)
+ "With indentation variables set as in another major mode do things.
+Same as `mumamo-with-major-mode-fontification' but for
+indentation. See that function for some notes about MAJOR and
+BODY."
+ (declare (indent 1) (debug t))
+ `(mumamo-with-major-mode-setup ,major 'indentation ,@body))
+
+;; fix-me: tell no sub-chunks in sub-chunks
+;;;###autoload
+(defmacro define-mumamo-multi-major-mode (fun-sym spec-doc chunks)
+ "Define a function that turn on support for multiple major modes.
+Define a function FUN-SYM that set up to divide the current
+buffer into chunks with different major modes.
+
+The documentation string for FUN-SYM should contain the special
+documentation in the string SPEC-DOC, general documentation for
+functions of this type and information about chunks.
+
+The new function will use the definitions in CHUNKS \(which is
+called a \"chunk family\") to make the dividing of the buffer.
+
+The function FUN-SYM can be used to setup a buffer instead of a
+major mode function:
+
+- The function FUN-SYM can be called instead of calling a major
+ mode function when you want to use multiple major modes in a
+ buffer.
+
+- The defined function can be used instead of a major mode
+ function in for example `auto-mode-alist'.
+
+- As the very last thing FUN-SYM will run the hook FUN-SYM-hook,
+ just as major modes do.
+
+- There is also a general hook, `mumamo-turn-on-hook', which is
+ run when turning on mumamo with any of these functions. This
+ is run right before the hook specific to any of the functions
+ above that turns on the multiple major mode support.
+
+- The multi major mode FUN-SYM has a keymap named FUN-SYM-map.
+ This overrides the major modes' keymaps since it is handled as
+ a minor mode keymap.
+
+- There is also a special mumamo keymap, `mumamo-map' that is
+ active in every buffer with a multi major mode. This is also
+ handled as a minor mode keymap and therefor overrides the major
+ modes' keymaps.
+
+- However when this support for multiple major mode is on the
+ buffer is divided into chunks, each with its own major mode.
+
+- The chunks are fontified according the major mode assigned to
+ them for that.
+
+- Indenting is also done according to the major mode assigned to
+ them for that.
+
+- The actual major mode used in the buffer is changed to the one
+ in the chunk when moving point between these chunks.
+
+- When major mode is changed the hooks for the new major mode,
+ `after-change-major-mode-hook' and `change-major-mode-hook' are
+ run.
+
+- There will be an alias for FUN-SYM called mumamo-alias-FUN-SYM.
+ This can be used to check whic multi major modes have been
+ defined.
+
+** A little bit more technical description:
+
+The dividing of a buffer into chunks is done during fontification
+by `mumamo-get-chunk-at'.
+
+The name of the function is saved in in the buffer local variable
+`mumamo-multi-major-mode' when the function is called.
+
+All functions defined by this macro is added to the list
+`mumamo-defined-multi-major-modes'.
+
+Basically Mumamo handles only major modes that uses jit-lock.
+However as a special effort also `nxml-mode' and derivatives
+thereof are handled. Since it seems impossible to me to restrict
+those major modes fontification to only a chunk without changing
+`nxml-mode' the fontification is instead done by
+`html-mode'/`sgml-mode' for chunks using `nxml-mode' and its
+derivates.
+
+CHUNKS is a list where each entry have the format
+
+ \(CHUNK-DEF-NAME MAIN-MAJOR-MODE SUBMODE-CHUNK-FUNCTIONS)
+
+CHUNK-DEF-NAME is the key name by which the entry is recognized.
+MAIN-MAJOR-MODE is the major mode used when there is no chunks.
+If this is nil then `major-mode' before turning on this mode will
+be used.
+
+SUBMODE-CHUNK-FUNCTIONS is a list of the functions that does the
+chunk division of the buffer. They are tried in the order they
+appear here during the chunk division process.
+
+If you want to write new functions for chunk divisions then
+please see `mumamo-find-possible-chunk'. You can perhaps also
+use `mumamo-quick-static-chunk' which is more easy-to-use
+alternative. See also the file mumamo-fun.el where there are
+many routines for chunk division.
+
+When you write those new functions you may want to use some of
+the functions for testing chunks:
+
+ `mumamo-test-create-chunk-at' `mumamo-test-create-chunks-at-all'
+ `mumamo-test-easy-make' `mumamo-test-fontify-region'
+
+These are in the file mumamo-test.el."
+ ;;(let ((c (if (symbolp chunks) (symbol-value chunks) chunks))) (message "c=%S" c))
+ (let* (;;(mumamo-describe-chunks (make-symbol "mumamo-describe-chunks"))
+ (turn-on-fun (if (symbolp fun-sym)
+ fun-sym
+ (error "Parameter FUN-SYM must be a symbol")))
+ (turn-on-fun-alias (intern (concat "mumamo-alias-" (symbol-name fun-sym))))
+ ;; Backward compatibility nXhtml v 1.60
+ (turn-on-fun-old (when (string= (substring (symbol-name fun-sym) -5)
+ "-mode")
+ (intern (substring (symbol-name fun-sym) 0 -5))))
+ (turn-on-hook (intern (concat (symbol-name turn-on-fun) "-hook")))
+ (turn-on-map (intern (concat (symbol-name turn-on-fun) "-map")))
+ (turn-on-hook-doc (concat "Hook run at the very end of `"
+ (symbol-name turn-on-fun) "'."))
+ (chunks2 (if (symbolp chunks)
+ (symbol-value chunks)
+ chunks))
+ (docstring
+ (concat
+ spec-doc
+ "
+
+
+
+This function is called a multi major mode. It sets up for
+multiple major modes in the buffer in the following way:
+
+"
+ ;; Fix-me: During byte compilation the next line is not
+ ;; expanded as I thought because the functions in CHUNKS
+ ;; are not defined. How do I fix this? Move out the
+ ;; define-mumamo-multi-major-mode calls?
+ (funcall 'mumamo-describe-chunks chunks2)
+ "
+At the very end this multi major mode function runs first the hook
+`mumamo-turn-on-hook' and then `" (symbol-name turn-on-hook) "'.
+
+There is a keymap specific to this multi major mode, but it is
+not returned by `current-local-map' which returns the chunk's
+major mode's local keymap.
+
+The multi mode keymap is named `" (symbol-name turn-on-map) "'.
+
+
+
+The main use for a multi major mode is to use it instead of a
+normal major mode in `auto-mode-alist'. \(You can of course call
+this function directly yourself too.)
+
+The value of `mumamo-multi-major-mode' tells you which multi
+major mode if any has been turned on in a buffer. For more
+information about multi major modes please see
+`define-mumamo-multi-major-mode'.
+
+Note: When adding new font-lock keywords for major mode chunks
+you should use the function `mumamo-refresh-multi-font-lock'
+afterwards.
+" )))
+ `(progn
+ ;;(add-to-list 'mumamo-defined-multi-major-modes (cons (car ',chunks2) ',turn-on-fun))
+ (mumamo-add-to-defined-multi-major-modes (cons (car ',chunks2) ',turn-on-fun))
+ (defvar ,turn-on-hook nil ,turn-on-hook-doc)
+ (defvar ,turn-on-map (make-sparse-keymap)
+ ,(concat "Keymap for multi major mode function `"
+ (symbol-name turn-on-fun) "'"))
+ (defvar ,turn-on-fun nil)
+ (make-variable-buffer-local ',turn-on-fun)
+ (put ',turn-on-fun 'permanent-local t)
+ (put ',turn-on-fun 'mumamo-chunk-family (copy-tree ',chunks2))
+ (put ',turn-on-fun-alias 'mumamo-chunk-family (copy-tree ',chunks2))
+ (defun ,turn-on-fun nil ,docstring
+ (interactive)
+ (let ((old-major-mode (or mumamo-major-mode
+ major-mode)))
+ (kill-all-local-variables)
+ (run-hooks 'change-major-mode-hook)
+ (setq mumamo-multi-major-mode ',turn-on-fun)
+ (setq ,turn-on-fun t)
+ (mumamo-add-multi-keymap ',turn-on-fun ,turn-on-map)
+ (setq mumamo-current-chunk-family (copy-tree ',chunks2))
+ (mumamo-turn-on-actions old-major-mode)
+ (run-hooks ',turn-on-hook)))
+ (defalias ',turn-on-fun-alias ',turn-on-fun)
+ (when (intern-soft ',turn-on-fun-old)
+ (defalias ',turn-on-fun-old ',turn-on-fun))
+ )))
+
+;;;###autoload
+(defun mumamo-add-to-defined-multi-major-modes (entry)
+ (add-to-list 'mumamo-defined-multi-major-modes entry))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Debugging etc
+
+(defsubst mumamo-while (limit counter where)
+ (let ((count (symbol-value counter)))
+ (if (= count limit)
+ (progn
+ (msgtrc "Reached (while limit=%s, where=%s)" limit where)
+ nil)
+ (set counter (1+ count)))))
+
+;; (defun dbg-smarty-err ()
+;; ;; (insert "}{")
+
+;; ;; (insert "}{")
+;; ;; (backward-char)
+;; ;; (backward-char)
+;; ;; (search-backward "}")
+
+;; ;; This gives an error rather often, but not always:
+;; (delete-char 3)
+;; (search-backward "}")
+;; )
+
+;; (defun dbg-smarty-err2 ()
+;; (forward-char 5)
+;; (insert "}{")
+;; ;; Start in nxhtml part and make sure the insertion is in smarty
+;; ;; part. Gives reliably an error if moved backward so point stay in
+;; ;; the new nxhtml-mode part, otherwise not.
+;; ;;
+;; ;; Eh, no. If chunk family is changed and reset there is no more an
+;; ;; error.
+;; ;;
+;; ;; Seems to be some race condition, but I am unable to understand
+;; ;; how. I believed that nxml always left in a reliable state. Is
+;; ;; this a state problem in mumamo or nxml? I am unable to make it
+;; ;; happen again now.
+;; ;;
+;; ;; I saw one very strange thing: The error message got inserted in
+;; ;; the .phps buffer once. How could this happen? Is this an Emacs
+;; ;; bug? Can't see how this could happen since it is the message
+;; ;; function that outputs the message. A w32 race condition? Are
+;; ;; people aware that the message queue runs in parallell? (I have
+;; ;; tried to ask on the devel list, but got no answer at that time.)
+;; (backward-char 2)
+;; )
+
+
+(defvar msgtrc-buffer
+ "*Messages*"
+ ;;"*trace-output*"
+ "Buffer or name of buffer for trace messages.
+See `msgtrc'."
+ )
+
+(defun msgtrc (format-string &rest args)
+ "Print message to `msgtrc-buffer'.
+Arguments FORMAT-STRING and ARGS are like for `message'."
+ (if nil
+ nil ;;(apply 'message format-string args)
+ ;; bug#3350 prevents use of this:
+ (let ((trc-buffer (get-buffer-create msgtrc-buffer))
+ ;; Cure 3350: Stop insert from deactivating the mark
+ (deactivate-mark))
+ (with-current-buffer trc-buffer
+ (goto-char (point-max))
+ (insert "MU:" (apply 'format format-string args) "\n")
+ ;;(insert "constant string\n")
+ (when buffer-file-name (write-region nil nil buffer-file-name))))))
+
+(defvar mumamo-message-file-buffer nil)
+(defsubst mumamo-msgtrc-to-file ()
+ "Start writing message to file. Erase `msgtrc-buffer' first."
+ (unless mumamo-message-file-buffer
+ (setq mumamo-message-file-buffer (find-file-noselect "c:/emacs/bugs/temp-messages.txt"))
+ (setq msgtrc-buffer mumamo-message-file-buffer)
+ (with-current-buffer mumamo-message-file-buffer
+ (erase-buffer))))
+
+(defvar mumamo-display-error-lwarn nil
+ "Set to t to call `lwarn' on fontification errors.
+If this is t then `*Warnings*' buffer will popup on fontification
+errors.")
+(defvar mumamo-display-error-stop nil
+ "Set to t to stop fontification on errors.")
+
+(defun mumamo-message-with-face (msg face)
+ "Put MSG with face FACE in *Messages* buffer."
+ (let ((start (+ (with-current-buffer msgtrc-buffer
+ (point-max))
+ 1))
+ ;; This is for the echo area:
+ (msg-with-face (propertize (format "%s" msg)
+ 'face face)))
+
+ (msgtrc "%s" msg-with-face)
+ ;; This is for the buffer:
+ (with-current-buffer msgtrc-buffer
+ (goto-char (point-max))
+ (backward-char)
+ (put-text-property start (point)
+ 'face face))))
+
+;;(run-with-idle-timer 1 nil 'mumamo-show-report-message)
+(defun mumamo-show-report-message ()
+ "Tell the user there is a long error message."
+ (save-match-data ;; runs in timer
+ (mumamo-message-with-face
+ "MuMaMo error, please look in the *Messages* buffer"
+ 'highlight)))
+
+;; This code can't be used now because `debugger' is currently not
+;; useable in timers. I keep it here since I hope someone will make it
+;; possible in the future.
+;;
+;; (defmacro mumamo-get-backtrace-if-error (bodyform)
+;; "Evaluate BODYFORM, return a list with error message and backtrace.
+;; If there is an error in BODYFORM then return a list with the
+;; error message and the backtrace as a string. Otherwise return
+;; nil."
+;; `(let* ((debugger
+;; (lambda (&rest debugger-args)
+;; (let ((debugger-ret (with-output-to-string (backtrace))))
+;; ;; I believe we must put the result in a buffer,
+;; ;; otherwise `condition-case' might erase it:
+;; (with-current-buffer (get-buffer-create "TEMP GET BACKTRACE")
+;; (erase-buffer)
+;; (insert debugger-ret)))))
+;; (debug-on-error t)
+;; (debug-on-signal t))
+;; (mumamo-condition-case err
+;; (progn
+;; ,bodyform
+;; nil)
+;; (error
+;; (let* ((errmsg (error-message-string err))
+;; (dbg1-ret
+;; (with-current-buffer
+;; (get-buffer "TEMP GET BACKTRACE") (buffer-string)))
+;; ;; Remove lines from this routine:
+;; (debugger-lines (split-string dbg1-ret "\n"))
+;; (dbg-ret (mapconcat 'identity (nthcdr 6 debugger-lines) "\n"))
+;; )
+;; (list errmsg (concat errmsg "\n" dbg-ret)))))))
+
+;;(mumamo-display-error 'test-lwarn-type "testing 1=%s, 2=%s" "one" 'two)
+(defun mumamo-display-error (lwarn-type format-string &rest args)
+ "Display a message plus traceback in the *Messages* buffer.
+Use this for errors that happen during fontification or when
+running a timer.
+
+LWARN-TYPE is used as the type argument to `lwarn' if warnings
+are displayed. FORMAT-STRING and ARGS are used as the
+corresponding arguments to `message' and `lwarn'.
+
+All the output from this function in the *Messages* buffer is
+displayed with the highlight face. After the message printed by
+`message' is traceback from where this function was called.
+Note: There is no error generated, just a traceback that is put
+in *Messages* as above.
+
+Display an error message using `message' and colorize it using
+the `highlight' face to make it more prominent. Add a backtrace
+colored with the `highlight' face to the buffer *Messages*. Then
+display the error message once again after this so that the user
+can see it.
+
+If `mumamo-display-error-lwarn' is non-nil, indicate the error by
+calling `lwarn'. This will display the `*Warnings*' buffer and
+thus makes it much more easy to spot that there was an error.
+
+If `mumamo-display-error-stop' is non-nil raise an error that may
+stop fontification."
+
+ ;; Warnings are sometimes disturbning, make it optional:
+ (when mumamo-display-error-lwarn
+ (apply 'lwarn lwarn-type :error format-string args))
+
+ (let ((format-string2 (concat "%s: " format-string))
+ (bt (with-output-to-string (backtrace))))
+
+ (mumamo-message-with-face
+ (concat
+ (apply 'format format-string2 lwarn-type args)
+ "\n"
+ (format "** In buffer %s\n" (current-buffer))
+ bt)
+ 'highlight)
+
+ ;; Output message once again so the user can see it:
+ (apply 'message format-string2 lwarn-type args)
+ ;; But ... there might be more messages so wait until things has
+ ;; calmed down and then show a message telling that there was an
+ ;; error and that there is more information in the *Messages*
+ ;; buffer.
+ (run-with-idle-timer 1 nil 'mumamo-show-report-message)
+
+ ;; Stop fontifying:
+ (when mumamo-display-error-stop
+ ;;(font-lock-mode -1)
+ (setq font-lock-mode nil)
+ (when (timerp jit-lock-context-timer)
+ (cancel-timer jit-lock-context-timer))
+ (when (timerp jit-lock-defer-timer)
+ (cancel-timer jit-lock-defer-timer))
+ (apply 'error format-string2 lwarn-type args))))
+
+
+(defun mumamo-debug-to-backtrace (&rest debugger-args)
+ "This function should give a backtrace during fontification errors.
+The variable `debugger' should then be this function. See the
+function `debug' for an explanation of DEBUGGER-ARGS.
+
+Fix-me: Can't use this function yet since the display routines
+uses safe_eval and safe_call."
+ (mumamo-display-error 'mumamo-debug-to-backtrace
+ "%s"
+ (nth 1 debugger-args)))
+
+;; (defun my-test-err3 ()
+;; (interactive)
+;; (let ((debugger 'mumamo-debug-to-backtrace)
+;; (debug-on-error t))
+;; (my-err)
+;; ))
+;;(my-test-err3()
+
+;;(set-default 'mumamo-use-condition-case nil)
+;;(set-default 'mumamo-use-condition-case t)
+(defvar mumamo-use-condition-case t)
+(make-variable-buffer-local 'mumamo-use-condition-case)
+(put 'mumamo-use-condition-case 'permanent-local t)
+
+(defvar mumamo-debugger 'mumamo-debug-to-backtrace)
+(make-variable-buffer-local 'mumamo-debugger)
+(put 'mumamo-debugger 'permanent-local t)
+
+;; (defun my-test-err4 ()
+;; (interactive)
+;; (mumamo-condition-case err
+;; (my-errx)
+;; (arith-error (message "here"))
+;; (error (message "%s, %s" err (error-message-string err)))
+;; ))
+
+(defvar mumamo-warned-once nil)
+(make-variable-buffer-local 'mumamo-warned-once)
+(put 'mumamo-warned-once 'permanent-local t)
+
+ ; (append '(0 1) '(a b))
+(defun mumamo-warn-once (type message &rest args)
+ "Warn only once with TYPE, MESSAGE and ARGS.
+If the same problem happens again then do not warn again."
+ (let ((msgrec (append (list type message) args)))
+ (unless (member msgrec mumamo-warned-once)
+ (setq mumamo-warned-once
+ (cons msgrec mumamo-warned-once))
+ ;;(apply 'lwarn type :warning message args)
+ (apply 'message (format "%s: %s" type message) args)
+ )))
+
+(defun mumamo-add-help-tabs ()
+ "Add key bindings for moving between buttons.
+Add bindings similar to those in `help-mode' for moving between
+text buttons."
+ (local-set-key [tab] 'forward-button)
+ (local-set-key [(meta tab)] 'backward-button)
+ (local-set-key [(shift tab)] 'backward-button)
+ (local-set-key [backtab] 'backward-button))
+
+(defun mumamo-insert-describe-button (symbol type)
+ "Insert a text button that describes SYMBOL of type TYPE."
+ (let ((func `(lambda (btn)
+ (funcall ',type ',symbol))))
+ (mumamo-add-help-tabs)
+ (insert-text-button
+ (symbol-name symbol)
+ :type 'help-function
+ 'face 'link
+ 'action func)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Custom group
+
+;;;###autoload
+(defgroup mumamo nil
+ "Customization group for multiple major modes in a buffer."
+ :group 'editing
+ :group 'languages
+ :group 'sgml
+ :group 'nxhtml
+ )
+
+;;(setq mumamo-set-major-mode-delay -1)
+;;(setq mumamo-set-major-mode-delay 5)
+(defcustom mumamo-set-major-mode-delay idle-update-delay
+ "Delay this number of seconds before setting major mode.
+When point enters a region where the major mode should be
+different than the current major mode, wait until Emacs has been
+idle this number of seconds before switching major mode.
+
+If negative switch major mode immediately.
+
+Ideally the switching of major mode should occur immediately when
+entering a region. However this can make movements a bit unsmooth
+for some major modes on a slow computer. Therefore on a slow
+computer use a short delay.
+
+If you have a fast computer and want to use mode specific
+movement commands then set this variable to -1.
+
+I tried to measure the time for switching major mode in mumamo.
+For most major modes it took 0 ms, but for `nxml-mode' and its
+derivate it took 20 ms on a 3GHz CPU."
+ :type 'number
+ :group 'mumamo)
+
+
+(defgroup mumamo-display nil
+ "Customization group for mumamo chunk display."
+ :group 'mumamo)
+
+(defun mumamo-update-this-buffer-margin-use ()
+ (mumamo-update-buffer-margin-use (current-buffer)))
+
+(define-minor-mode mumamo-margin-info-mode
+ "Display chunk info in margin when on.
+Display chunk depth and major mode where a chunk begin in left or
+right margin. \(The '-mode' part of the major mode is stripped.)
+
+See also `mumamo-margin-use'.
+
+Note: When `linum-mode' is on the right margin is always used
+now \(since `linum-mode' uses the left)."
+ :group 'mumamo-display
+ (mumamo-update-this-buffer-margin-use)
+ (if mumamo-margin-info-mode
+ (progn
+ ;;(add-hook 'window-configuration-change-hook 'mumamo-update-this-buffer-margin-use nil t)
+ (add-hook 'linum-mode-hook 'mumamo-update-this-buffer-margin-use nil t)
+ )
+ ;;(remove-hook 'window-configuration-change-hook 'mumamo-update-this-buffer-margin-use t)
+ (remove-hook 'linum-mode-hook 'mumamo-update-this-buffer-margin-use t)
+ ))
+;;(put 'mumamo-margin-info-mode 'permanent-local t)
+
+(defun mumamo-margin-info-mode-turn-off ()
+ (mumamo-margin-info-mode -1))
+(put 'mumamo-margin-info-mode-turn-off 'permanent-local-hook t)
+
+(define-globalized-minor-mode mumamo-margin-info-global-mode mumamo-margin-info-mode
+ (lambda () (when (and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode)
+ (mumamo-margin-info-mode 1)))
+ :group 'mumamo-display)
+
+(defcustom mumamo-margin-use '(left-margin 13)
+ "Display chunk info in left or right margin if non-nil."
+ :type '(list (radio (const :tag "Display chunk info in left margin" left-margin)
+ (const :tag "Display chunk info in right margin" right-margin))
+ (integer :tag "Margin width (when used)" :value 13))
+ :set (lambda (sym val)
+ (set-default sym val)
+ (when (fboundp 'mumamo-update-all-buffers-margin-use)
+ (mumamo-update-all-buffers-margin-use)))
+ :group 'mumamo-display)
+
+(defun mumamo-update-all-buffers-margin-use ()
+ (dolist (buf (buffer-list))
+ (mumamo-update-buffer-margin-use buf)))
+
+(define-minor-mode mumamo-no-chunk-coloring
+ "Use no background colors to distinguish chunks.
+When this minor mode is on in a buffer no chunk coloring is done
+in that buffer. This is overrides `mumamo-chunk-coloring'. It
+is meant for situations when you temporarily need to remove the
+background colors."
+ :lighter " ΓΈ"
+ :group 'mumamo-display
+ (font-lock-mode -1)
+ (font-lock-mode 1))
+(put 'mumamo-no-chunk-coloring 'permanent-local t)
+
+
+;; (setq mumamo-chunk-coloring 4)
+(defcustom mumamo-chunk-coloring 0
+ "Color chunks with depth greater than or equal to this.
+When 0 all chunks will be colored. If 1 all sub mode chunks will
+be colored, etc."
+ :type '(integer :tag "Color chunks with depth greater than this")
+ :group 'mumamo-display)
+
+(defface mumamo-background-chunk-major
+ '((((class color) (min-colors 88) (background dark))
+ ;;:background "blue3")
+ :background "MidnightBlue")
+ (((class color) (min-colors 88) (background light))
+ ;;:background "lightgoldenrod2")
+ :background "cornsilk")
+ (((class color) (min-colors 16) (background dark))
+ :background "blue4")
+ (((class color) (min-colors 16) (background light))
+ :background "cornsilk")
+ (((class color) (min-colors 8))
+ :background "blue")
+ (((type tty) (class mono))
+ :inverse-video t)
+ (t :background "gray"))
+ "Background colors for chunks in sub modes.
+You should only specify :background here, otherwise it will
+interfere with syntax highlighting."
+ :group 'mumamo-display)
+
+(defface mumamo-background-chunk-submode1
+ '((((class color) (min-colors 88) (background dark))
+ ;;:background "blue3")
+ :background "DarkGreen"
+ ;;:background "#081010"
+ )
+ (((class color) (min-colors 88) (background light))
+ ;;:background "lightgoldenrod2")
+ :background "Azure")
+ (((class color) (min-colors 16) (background dark))
+ :background "blue3")
+ (((class color) (min-colors 16) (background light))
+ :background "azure")
+ (((class color) (min-colors 8))
+ :background "Blue")
+ (((type tty) (class mono))
+ :inverse-video t)
+ (t :background "gray"))
+ "Background colors for chunks in major mode.
+You should only specify :background here, otherwise it will
+interfere with syntax highlighting."
+ :group 'mumamo-display)
+
+(defface mumamo-background-chunk-submode2
+ '((((class color) (min-colors 88) (background dark))
+ ;;:background "blue3")
+ :background "dark green")
+ (((class color) (min-colors 88) (background light))
+ ;;:background "lightgoldenrod2")
+ :background "#e6ff96")
+ (((class color) (min-colors 16) (background dark))
+ :background "blue3")
+ (((class color) (min-colors 16) (background light))
+ :background "azure")
+ (((class color) (min-colors 8))
+ :background "blue")
+ (((type tty) (class mono))
+ :inverse-video t)
+ (t :background "gray"))
+ "Background colors for chunks in major mode.
+You should only specify :background here, otherwise it will
+interfere with syntax highlighting."
+ :group 'mumamo-display)
+
+(defface mumamo-background-chunk-submode3
+ '((((class color) (min-colors 88) (background dark))
+ ;;:background "blue3")
+ :background "dark green")
+ (((class color) (min-colors 88) (background light))
+ ;;:background "lightgoldenrod2")
+ :background "#f7d1f4")
+ ;;:background "green")
+ (((class color) (min-colors 16) (background dark))
+ :background "blue3")
+ (((class color) (min-colors 16) (background light))
+ :background "azure")
+ (((class color) (min-colors 8))
+ :background "blue")
+ (((type tty) (class mono))
+ :inverse-video t)
+ (t :background "gray"))
+ "Background colors for chunks in major mode.
+You should only specify :background here, otherwise it will
+interfere with syntax highlighting."
+ :group 'mumamo-display)
+
+(defface mumamo-background-chunk-submode4
+ '((((class color) (min-colors 88) (background dark))
+ ;;:background "blue3")
+ :background "dark green")
+ (((class color) (min-colors 88) (background light))
+ ;;:background "lightgoldenrod2")
+ :background "orange")
+ (((class color) (min-colors 16) (background dark))
+ :background "blue3")
+ (((class color) (min-colors 16) (background light))
+ :background "azure")
+ (((class color) (min-colors 8))
+ :background "blue")
+ (((type tty) (class mono))
+ :inverse-video t)
+ (t :background "gray"))
+ "Background colors for chunks in major mode.
+You should only specify :background here, otherwise it will
+interfere with syntax highlighting."
+ :group 'mumamo-display)
+
+(defcustom mumamo-background-chunk-major 'mumamo-background-chunk-major
+ "Background colors for chunks in major mode.
+Pointer to face with background color.
+
+If you do not want any special background color use the face named
+default."
+ :type 'face
+ :group 'mumamo-display)
+
+(defcustom mumamo-background-chunk-submode1 'mumamo-background-chunk-submode1
+ "Background colors for chunks in sub modes.
+Pointer to face with background color.
+
+If you do not want any special background color use the face named
+default."
+ :type 'face
+ :group 'mumamo-display)
+
+(defcustom mumamo-background-chunk-submode2 'mumamo-background-chunk-submode2
+ "Background colors for chunks in sub modes.
+Pointer to face with background color.
+
+If you do not want any special background color use the face named
+default."
+ :type 'face
+ :group 'mumamo-display)
+
+(defcustom mumamo-background-chunk-submode3 'mumamo-background-chunk-submode3
+ "Background colors for chunks in sub modes.
+Pointer to face with background color.
+
+If you do not want any special background color use the face named
+default."
+ :type 'face
+ :group 'mumamo-display)
+
+(defcustom mumamo-background-chunk-submode4 'mumamo-background-chunk-submode4
+ "Background colors for chunks in sub modes.
+Pointer to face with background color.
+
+If you do not want any special background color use the face named
+default."
+ :type 'face
+ :group 'mumamo-display)
+
+;; Fix-me: use and enhance this
+(defcustom mumamo-background-colors '(mumamo-background-chunk-major
+ mumamo-background-chunk-submode1
+ mumamo-background-chunk-submode2
+ mumamo-background-chunk-submode3
+ mumamo-background-chunk-submode4
+ )
+ "List of background colors in order of use.
+First color is for main major mode chunks, then for submode
+chunks, sub-submode chunks etc. Colors are reused in cyclic
+order.
+
+The default colors are choosen so that inner chunks has a more
+standing out color the further in you get. This is supposed to
+be helpful when you make mistakes and the chunk nesting is not
+what you intended.
+
+Note: Only the light background colors have been set by me. The
+dark background colors might currently be unuseful.
+Contributions and suggestions are welcome!
+
+The values in the list should be symbols. Each symbol should either be
+
+ 1: a variable symbol pointing to a face (or beeing nil)
+ 2: a face symbol
+ 3: a function with one argument (subchunk depth) returning a
+ face symbol"
+ :type '(repeat symbol)
+ :group 'mumamo-display)
+
+;;(mumamo-background-color 0)
+;;(mumamo-background-color 1)
+;;(mumamo-background-color 2)
+(defun mumamo-background-color (sub-chunk-depth)
+ (when (and (not mumamo-no-chunk-coloring)
+ (or (not (integerp mumamo-chunk-coloring)) ;; Old values
+ (>= sub-chunk-depth mumamo-chunk-coloring)))
+ (let* ((idx (when mumamo-background-colors
+ (mod sub-chunk-depth (length mumamo-background-colors))))
+ (sym (when idx (nth idx mumamo-background-colors)))
+ fac)
+ (when sym
+ (when (boundp sym)
+ (setq fac (symbol-value sym))
+ (unless (facep fac) (setq fac nil)))
+ (unless fac
+ (when (facep sym)
+ (setq fac sym)))
+ (unless fac
+ (when (fboundp sym)
+ (setq fac (funcall sym sub-chunk-depth))))
+ (when fac
+ (unless (facep fac)
+ (setq fac nil)))
+ fac
+ ))))
+
+(defface mumamo-border-face-in
+ '((t (:inherit font-lock-preprocessor-face :bold t :italic t :underline t)))
+ "Face for marking borders."
+ :group 'mumamo-display)
+
+(defface mumamo-border-face-out
+ '((t (:inherit font-lock-preprocessor-face :bold t :italic t :underline t)))
+ "Face for marking borders."
+ :group 'mumamo-display)
+
+
+(defgroup mumamo-indentation nil
+ "Customization group for mumamo chunk indentation."
+ :group 'mumamo)
+
+(defcustom mumamo-submode-indent-offset 2
+ "Indentation of submode relative outer major mode.
+If this is nil then indentation first non-empty line in a
+subchunk will \(normally) be 0. See however
+`mumamo-indent-line-function-1' for special handling of first
+line in subsequent subchunks.
+
+See also `mumamo-submode-indent-offset-0'."
+ :type '(choice integer
+ (const :tag "No special"))
+ :group 'mumamo-indentation)
+
+(defcustom mumamo-submode-indent-offset-0 0
+ "Indentation of submode at column 0.
+This value overrides `mumamo-submode-indent-offset' when the
+outer major mode above has indentation 0."
+ :type '(choice integer
+ (const :tag "No special"))
+ :group 'mumamo-indentation)
+
+(defcustom mumamo-indent-major-to-use
+ '(
+ ;;(nxhtml-mode html-mode)
+ (html-mode nxhtml-mode)
+ )
+ "Major mode to use for indentation.
+This is normally the major mode specified for the chunk. Here you
+can make exceptions."
+ :type '(repeat
+ (list (symbol :tag "Major mode symbol specified")
+ (command :tag "Major mode to use")))
+ :group 'mumamo-indentation)
+
+;;(mumamo-indent-get-major-to-use 'nxhtml-mode)
+;;(mumamo-indent-get-major-to-use 'html-mode)
+(defun mumamo-indent-get-major-to-use (major depth)
+ (or (and (= depth 0)
+ (cadr (assq major mumamo-indent-major-to-use)))
+ major))
+
+(defcustom mumamo-indent-widen-per-major
+ '(
+ (php-mode (use-widen))
+ (nxhtml-mode (use-widen (html-mumamo-mode nxhtml-mumamo-mode)))
+ (html-mode (use-widen (html-mumamo-mode nxhtml-mumamo-mode)))
+ )
+ "Wether do widen buffer during indentation.
+If not then the buffer is narrowed to the current chunk when
+indenting a line in a chunk."
+ :type '(repeat
+ (list (symbol :tag "Major mode symbol")
+ (set
+ (const :tag "Widen buffer during indentation" use-widen)
+ (repeat (command :tag "Widen if multi major is any of those"))
+ )))
+ :group 'mumamo-indentation)
+
+
+;;;###autoload
+(defgroup mumamo-hi-lock-faces nil
+ "Faces for hi-lock that are visible in mumamo multiple modes.
+This is a workaround for the problem that text properties are
+always hidden behind overlay dito.
+
+This faces are not as visible as those that defines background
+colors. However they use underlining so they are at least
+somewhat visible."
+ :group 'hi-lock
+ :group 'mumamo-display
+ :group 'faces)
+
+(defface hi-mumamo-yellow
+ '((((min-colors 88) (background dark))
+ (:underline "yellow1"))
+ (((background dark)) (:underline "yellow"))
+ (((min-colors 88)) (:underline "yellow1"))
+ (t (:underline "yellow")))
+ "Default face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+(defface hi-mumamo-pink
+ '((((background dark)) (:underline "pink"))
+ (t (:underline "pink")))
+ "Face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+(defface hi-mumamo-green
+ '((((min-colors 88) (background dark))
+ (:underline "green1"))
+ (((background dark)) (:underline "green"))
+ (((min-colors 88)) (:underline "green1"))
+ (t (:underline "green")))
+ "Face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+(defface hi-mumamo-blue
+ '((((background dark)) (:underline "light blue"))
+ (t (:underline "light blue")))
+ "Face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+(defface hi-mumamo-black-b
+ '((t (:weight bold :underline t)))
+ "Face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+(defface hi-mumamo-blue-b
+ '((((min-colors 88)) (:weight bold :underline "blue1"))
+ (t (:weight bold :underline "blue")))
+ "Face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+(defface hi-mumamo-green-b
+ '((((min-colors 88)) (:weight bold :underline "green1"))
+ (t (:weight bold :underline "green")))
+ "Face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+(defface hi-mumamo-red-b
+ '((((min-colors 88)) (:weight bold :underline "red1"))
+ (t (:weight bold :underline "red")))
+ "Face for hi-lock mode."
+ :group 'mumamo-hi-lock-faces)
+
+
+;; (defcustom mumamo-check-chunk-major-same nil
+;; "Check if main major mode is the same as normal mode."
+;; :type 'boolean
+;; :group 'mumamo)
+
+;; (customize-option 'mumamo-major-modes)
+;;(require 'django)
+
+(defgroup mumamo-modes nil
+ "Customization group for mumamo chunk modes."
+ :group 'mumamo)
+
+(defcustom mumamo-major-modes
+ '(
+ (asp-js-mode
+ js-mode ;; Not autoloaded in the pretest
+ javascript-mode
+ espresso-mode
+ ecmascript-mode)
+ (asp-vb-mode
+ visual-basic-mode)
+ ;;(css-mode fundamental-mode)
+ (javascript-mode
+ js-mode ;; Not autoloaded in the pretest
+ javascript-mode
+ espresso-mode
+ ;;js2-fl-mode
+ ecmascript-mode)
+ (java-mode
+ jde-mode
+ java-mode)
+ (groovy-mode
+ groovy-mode)
+ ;; For Emacs 22 that do not have nxml by default
+ ;; Fix me: fallback when autoload fails!
+ (nxhtml-mode
+ nxhtml-mode
+ html-mode)
+ )
+ "Alist for conversion of chunk major mode specifier to major mode.
+Each entry has the form
+
+ \(MAJOR-SPEC MAJORMODE ...)
+
+where the symbol MAJOR-SPEC specifies the code type and should
+match the value returned from `mumamo-find-possible-chunk'. The
+MAJORMODE symbols are major modes that can be used for editing
+that code type. The first available MAJORMODE is the one that is
+used.
+
+The MAJOR-SPEC symbols are used by the chunk definitions in
+`define-mumamo-multi-major-mode'.
+
+The major modes are not specified directly in the chunk
+definitions. Instead a chunk definition contains a symbol that
+is looked up in this list to find the chunk's major mode.
+
+The reason for doing it this way is to make it possible to use
+new major modes with existing multi major modes. If for example
+someone writes a new CSS mode that could easily be used instead
+of the current one in `html-mumamo-mode'.
+
+Lookup in this list is done by `mumamo-major-mode-from-modespec'."
+ :type '(alist
+ :key-type (symbol :tag "Symbol for major mode spec in chunk")
+ :value-type (repeat (choice
+ (command :tag "Major mode")
+ (symbol :tag "Major mode (not yet loaded)")))
+ )
+ :group 'mumamo-modes)
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; JIT lock functions
+
+(defun mumamo-jit-lock-function (start)
+ "This function is added to `fontification-functions' by mumamo.
+START is a parameter given to functions in that hook."
+ (mumamo-msgfntfy "mumamo-jit-lock-function %s, ff=%s, just-changed=%s"
+ start
+ (when start
+ (save-restriction
+ (widen)
+ (get-text-property start 'fontified)))
+ mumamo-just-changed-major)
+ ;;(msgtrc "jit-lock-function %s, ff=%s, just-changed=%s" start (get-text-property start 'fontified) mumamo-just-changed-major)
+ ;;(msgtrc "mumamo-jit-lock-function enter: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
+ (if mumamo-just-changed-major
+ (setq mumamo-just-changed-major nil))
+ (let ((ret (jit-lock-function start)))
+ (mumamo-msgfntfy "mumamo-jit-lock-function EXIT %s, ff=%s, just-changed=%s"
+ start
+ (when start
+ (save-restriction
+ (widen)
+ (get-text-property start 'fontified)))
+ mumamo-just-changed-major)
+ ;;(msgtrc "mumamo-jit-lock-function exit: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
+ ret))
+
+(defun mumamo-jit-lock-register (fun &optional contextual)
+ "Replacement for `jit-lock-register'.
+Avoids refontification, otherwise same. FUN and CONTEXTUAL has
+the some meaning as there."
+ (add-hook 'jit-lock-functions fun nil t)
+ (when (and contextual jit-lock-contextually)
+ (set (make-local-variable 'jit-lock-contextually) t))
+
+ ;;(jit-lock-mode t)
+ ;;
+ ;; Replace this with the code below from jit-lock-mode t part:
+ (setq jit-lock-mode t)
+
+ ;; Mark the buffer for refontification.
+ ;; This is what we want to avoid in mumamo:
+ ;;(jit-lock-refontify)
+
+ ;; Install an idle timer for stealth fontification.
+ (when (and jit-lock-stealth-time (null jit-lock-stealth-timer))
+ (setq jit-lock-stealth-timer
+ (run-with-idle-timer jit-lock-stealth-time t
+ 'jit-lock-stealth-fontify)))
+
+ ;; Create, but do not activate, the idle timer for repeated
+ ;; stealth fontification.
+ (when (and jit-lock-stealth-time (null jit-lock-stealth-repeat-timer))
+ (setq jit-lock-stealth-repeat-timer (timer-create))
+ (timer-set-function jit-lock-stealth-repeat-timer
+ 'jit-lock-stealth-fontify '(t)))
+
+ ;; Init deferred fontification timer.
+ (when (and jit-lock-defer-time (null jit-lock-defer-timer))
+ (setq jit-lock-defer-timer
+ (run-with-idle-timer jit-lock-defer-time t
+ 'jit-lock-deferred-fontify)))
+
+ ;; Initialize contextual fontification if requested.
+ (when (eq jit-lock-contextually t)
+ (unless jit-lock-context-timer
+ (setq jit-lock-context-timer
+ (run-with-idle-timer jit-lock-context-time t
+ 'jit-lock-context-fontify)))
+ (setq jit-lock-context-unfontify-pos
+ (or jit-lock-context-unfontify-pos (point-max))))
+
+ ;; Setup our hooks.
+ ;;(add-hook 'after-change-functions 'jit-lock-after-change t t)
+ ;;(add-hook 'after-change-functions 'mumamo-jit-lock-after-change t t)
+ (add-hook 'after-change-functions 'mumamo-after-change t t)
+ ;; Set up fontification to call jit:
+ (let ((ff (reverse fontification-functions)))
+ (mapc (lambda (f)
+ ;;(unless (eq f 'jit-lock-function)
+ (remove-hook 'fontification-functions f t))
+ ;;)
+ ff))
+ (add-hook 'fontification-functions 'mumamo-jit-lock-function nil t)
+ )
+
+;; Fix-me: integrate this with fontify-region!
+(defvar mumamo-find-chunks-timer nil)
+(make-variable-buffer-local 'mumamo-find-chunks-timer)
+(put 'mumamo-find-chunks-timer 'permanent-local t)
+
+(defvar mumamo-find-chunk-delay idle-update-delay)
+(make-variable-buffer-local 'mumamo-find-chunk-delay)
+(put 'mumamo-find-chunk-delay 'permanent-local t)
+
+(defun mumamo-stop-find-chunks-timer ()
+ "Stop timer that find chunks."
+ (when (and mumamo-find-chunks-timer
+ (timerp mumamo-find-chunks-timer))
+ (cancel-timer mumamo-find-chunks-timer))
+ (setq mumamo-find-chunks-timer nil))
+
+(defun mumamo-start-find-chunks-timer ()
+ "Start timer that find chunks."
+ (mumamo-stop-find-chunks-timer)
+ ;; (setq mumamo-find-chunks-timer
+ ;; (run-with-idle-timer mumamo-find-chunk-delay nil
+ ;; 'mumamo-find-chunks-in-timer (current-buffer)))
+ )
+
+(defun mumamo-find-chunks-in-timer (buffer)
+ "Run `mumamo-find-chunks' in buffer BUFFER in a timer."
+ (mumamo-msgfntfy "mumamo-find-chunks-in-timer %s" buffer)
+ ;;(message "mumamo-find-chunks-in-timer %s" buffer)
+ (condition-case err
+ (when (buffer-live-p buffer)
+ (with-current-buffer buffer
+ (mumamo-find-chunks nil "mumamo-find-chunks-in-timer")))
+ (error (message "mumamo-find-chunks error: %s" err))))
+
+
+(defvar mumamo-last-chunk nil)
+(make-variable-buffer-local 'mumamo-last-chunk)
+(put 'mumamo-last-chunk 'permanent-local t)
+
+(defvar mumamo-last-change-pos nil)
+(make-variable-buffer-local 'mumamo-last-change-pos)
+(put 'mumamo-last-change-pos 'permanent-local t)
+
+;; Fix-me: maybe this belongs to contextual fontification? Eh,
+;; no. Unfortunately there is not way to make that handle more than
+;; multiple lines.
+(defvar mumamo-find-chunk-is-active nil
+ "Protect from recursive calls.")
+
+;; Fix-me: temporary things for testing new chunk routines.
+(defvar mumamo-find-chunks-level 0)
+(setq mumamo-find-chunks-level 0)
+
+(defvar mumamo-old-tail nil)
+(make-variable-buffer-local 'mumamo-old-tail)
+(put 'mumamo-old-tail 'permanent-local t)
+
+(defun mumamo-update-obscure (chunk pos)
+ "Update obscure cache."
+ (let ((obscured (overlay-get chunk 'obscured))
+ region-info)
+ (unless (and obscured (= (car obscured) pos))
+ (setq region-info (mumamo-get-region-from pos))
+ ;;(msgtrc "update-obscure:region-info=%s" region-info)
+ ;; This should not be a chunk here
+ (mumamo-put-obscure chunk pos region-info))))
+
+(defun mumamo-put-obscure (chunk pos region-or-chunk)
+ "Cache obscure info."
+ (assert (overlayp chunk) t)
+ (when pos (assert (or (markerp pos) (integerp pos)) t))
+ (let* ((region-info (if (overlayp region-or-chunk)
+ (cons (overlay-start region-or-chunk)
+ (overlay-end region-or-chunk))
+ region-or-chunk))
+ (obscured (when pos (list pos region-info))))
+ ;;(msgtrc "put-obscure:region-info=%s, obscured=%s" region-info obscured)
+ (when region-info (assert (consp region-info) t))
+ (assert (not (overlayp region-info)) t)
+ (overlay-put chunk 'obscured obscured)
+ (setq obscured (overlay-get chunk 'obscured))
+ ;;(msgtrc " obscured=%s" obscured)
+ ))
+
+(defun mumamo-get-region-from (point)
+ "Return mumamo region values for POINT."
+ ;; Note: `mumamo-get-region-from-1' is defined in mumamo-regions.el
+ (when (fboundp 'mumamo-get-region-from-1)
+ (mumamo-get-region-from-1 point)))
+
+(defun mumamo-clear-chunk-ppss-cache (chunk)
+ (overlay-put chunk 'mumamo-ppss-cache nil)
+ (overlay-put chunk 'mumamo-ppss-last nil)
+ (overlay-put chunk 'mumamo-ppss-stats nil))
+
+(defun mumamo-find-chunks (end tracer)
+ "Find or create chunks from last known chunk.
+Ie, start from the end of `mumamo-last-chunk' if this is
+non-nil, otherwise 1.
+
+If END is nil then continue till end of buffer or until any input
+is available. In this case the return value is undefined.
+
+Otherwise END must be a position in the buffer. Return the
+mumamo chunk containing the position. If `mumamo-last-chunk'
+ends before END then create chunks upto END."
+ (when mumamo-multi-major-mode
+ (let ((chunk (mumamo-find-chunks-1 end tracer))
+ region-info)
+ (when (and end chunk (featurep 'mumamo-regions))
+ (setq region-info (mumamo-get-region-from end))
+ ;;(msgtrc "find-chunks:region-info=%s" region-info)
+ (if (overlayp region-info)
+ (setq chunk region-info)
+ ;;(overlay-put chunk 'obscured (list end region-info))))
+ (mumamo-put-obscure chunk end region-info)))
+ ;;(msgtrc "find-chunks ret chunk=%s" chunk)
+ chunk)))
+
+(defun mumamo-move-to-old-tail (first-check-from)
+ "Divide the chunk list.
+Make it two parts. The first, before FIRST-CHECK-FROM is still
+correct but we want to check those after. Put thosie in
+`mumamo-old-tail'."
+ (let ((while-n0 0))
+ (while (and (mumamo-while 500 'while-n0 "mumamo-last-chunk first-check-from")
+ mumamo-last-chunk
+ first-check-from
+ (< first-check-from (overlay-end mumamo-last-chunk)))
+ (overlay-put mumamo-last-chunk 'mumamo-next-chunk mumamo-old-tail)
+ (setq mumamo-old-tail mumamo-last-chunk)
+ (overlay-put mumamo-old-tail 'mumamo-is-new nil)
+ (when nil ;; For debugging
+ (overlay-put mumamo-old-tail
+ 'face
+ (list :background
+ (format "red%d" (overlay-get mumamo-old-tail 'mumamo-depth)))))
+ (setq mumamo-last-chunk
+ (overlay-get mumamo-last-chunk 'mumamo-prev-chunk)))))
+
+(defun mumamo-delete-empty-chunks-at-end ()
+ ;; fix-me: later? Delete empty chunks at end, will be recreated if really needed
+ (let ((while-n1 0))
+ (while (and (mumamo-while 500 'while-n1 "mumamo-last-chunk del empty chunks")
+ mumamo-last-chunk
+ ;;(= (point-max) (overlay-end mumamo-last-chunk))
+ (= (overlay-end mumamo-last-chunk) (overlay-start mumamo-last-chunk)))
+ ;;(msgtrc "delete-overlay at end")
+ (delete-overlay mumamo-last-chunk)
+ (setq mumamo-last-chunk (overlay-get mumamo-last-chunk 'mumamo-prev-chunk))
+ (when mumamo-last-chunk (overlay-put mumamo-last-chunk 'mumamo-next-chunk nil)))))
+
+
+(defun mumamo-delete-chunks-upto (ok-pos)
+ "Delete old chunks upto OK-POS."
+ (or (not mumamo-old-tail)
+ (overlay-buffer mumamo-old-tail)
+ (setq mumamo-old-tail nil))
+ (let ((while-n2 0))
+ (while (and (mumamo-while 500 'while-n2 "mumamo-old-tail")
+ (and mumamo-old-tail (< (overlay-start mumamo-old-tail) ok-pos)))
+ (mumamo-mark-for-refontification (overlay-start mumamo-old-tail) (overlay-end mumamo-old-tail))
+ ;;(msgtrc "find-chunks:ok-pos=%s, not eq delete %s" ok-pos mumamo-old-tail)
+ (delete-overlay mumamo-old-tail)
+ (setq mumamo-old-tail (overlay-get mumamo-old-tail 'mumamo-next-chunk))
+ (or (not mumamo-old-tail)
+ (overlay-buffer mumamo-old-tail)
+ (setq mumamo-old-tail nil)))))
+
+(defun mumamo-reuse-old-tail-head ()
+ ;;(msgtrc "reusing %S" mumamo-old-tail)
+ (setq mumamo-last-chunk mumamo-old-tail)
+ (overlay-put mumamo-last-chunk 'mumamo-is-new t)
+ (mumamo-clear-chunk-ppss-cache mumamo-last-chunk)
+ (overlay-put mumamo-last-chunk 'face (mumamo-background-color (overlay-get mumamo-last-chunk 'mumamo-depth)))
+ (setq mumamo-old-tail (overlay-get mumamo-old-tail 'mumamo-next-chunk)))
+
+(defun mumamo-old-tail-fits (this-new-values)
+ (and mumamo-old-tail
+ (overlay-buffer mumamo-old-tail)
+ (mumamo-new-chunk-equal-chunk-values mumamo-old-tail this-new-values)))
+
+(defun mumamo-find-chunks-1 (end tracer) ;; min max)
+ ;; Note: This code must probably be reentrant. The globals changed
+ ;; here are `mumamo-last-chunk' and `mumamo-old-tail'. They must be
+ ;; handled as a pair.
+ (mumamo-msgfntfy "")
+ (setq mumamo-find-chunks-level (1+ mumamo-find-chunks-level))
+ (unless (and (overlayp mumamo-last-chunk) (overlay-buffer mumamo-last-chunk)) (setq mumamo-last-chunk nil))
+ (save-restriction
+ (widen)
+ (let* ((mumamo-find-chunks-1-active t)
+ (here (point))
+ ;; Any changes?
+ (change-min (car mumamo-last-change-pos))
+ (change-max (cdr mumamo-last-change-pos))
+ (chunk-at-change-min (when change-min (mumamo-get-existing-new-chunk-at change-min nil)))
+ (chunk-at-change-min-start (when chunk-at-change-min (overlay-start chunk-at-change-min)))
+ ;; Check if change is near border
+ (this-syntax-min-max
+ (when chunk-at-change-min
+ (mumamo-update-obscure chunk-at-change-min chunk-at-change-min-start)
+ (mumamo-chunk-syntax-min-max chunk-at-change-min nil)))
+ (this-syntax-min (car this-syntax-min-max))
+ (in-min-border (when this-syntax-min (>= this-syntax-min change-min)))
+ (first-check-from (if chunk-at-change-min
+ (if (or in-min-border
+ ;; Fix-me: 20?
+ (> 20 (- change-min chunk-at-change-min-start)))
+ (max 1
+ (- chunk-at-change-min-start 1))
+ chunk-at-change-min-start)
+ (when change-min
+ (goto-char change-min)
+ (skip-chars-backward "^\n")
+ (unless (bobp) (backward-char))
+ (prog1 (point) (goto-char here))))))
+ (when (and chunk-at-change-min (= 0 (- (overlay-end chunk-at-change-min)
+ (overlay-start chunk-at-change-min))))
+ (assert in-min-border)) ;; 0 len must be in border
+ (setq mumamo-last-change-pos nil)
+ (when chunk-at-change-min
+ (mumamo-move-to-old-tail first-check-from)
+ (mumamo-delete-empty-chunks-at-end))
+ ;; Now mumamo-last-chunk is the last in the top chain and
+ ;; mumamo-old-tail the first in the bottom chain.
+
+ (let* (
+ ;;(last-chunk-is-closed (when mumamo-last-chunk (overlay-get mumamo-last-chunk 'mumamo-is-closed)))
+ (last-chunk-is-closed t)
+ (ok-pos (or (and mumamo-last-chunk
+ (- (overlay-end mumamo-last-chunk)
+ ;;(or (and last-chunk-is-closed 1)
+ (or (and (/= (overlay-end mumamo-last-chunk)
+ (1+ (buffer-size)))
+ 1)
+ 0)))
+ 0))
+ (end-param end)
+ (end (or end (point-max)))
+ this-new-values
+ this-new-chunk
+ prev-chunk
+ first-change-pos
+ interrupted
+ (while-n3 0))
+ (when (>= ok-pos end)
+ (setq this-new-chunk (mumamo-get-existing-new-chunk-at end nil))
+ (unless this-new-chunk
+ (error "Could not find new chunk ok-pos-new=%s > end=%s (ovls at end=%s), level=%d, old-tail=%s, %S"
+ ok-pos end (overlays-in end end)
+ mumamo-find-chunks-level mumamo-old-tail tracer)))
+ (unless this-new-chunk
+ (save-match-data
+ (unless mumamo-find-chunk-is-active
+ ;;(setq mumamo-find-chunk-is-active t)
+ (mumamo-stop-find-chunks-timer)
+ (mumamo-save-buffer-state nil
+ (progn
+
+ ;; Loop forward until end or buffer end ...
+ (while (and (mumamo-while 1500 'while-n3 "until end")
+ (or (not end)
+ (<= ok-pos end))
+ ;;(prog1 t (msgtrc "ok-pos=%s in while" ok-pos))
+ (< ok-pos (point-max))
+ (not (setq interrupted (and (not end)
+ (input-pending-p)))))
+ ;; Narrow to speed up. However the chunk divider may be
+ ;; before ok-pos here. Assume that the marker is not
+ ;; longer than 200 chars. fix-me.
+ (narrow-to-region (max (- ok-pos 200) 1)
+ (1+ (buffer-size)))
+ ;; If this was after a change within one chunk then tell that:
+ (let ((use-change-max (when (and change-max
+ chunk-at-change-min
+ (overlay-buffer chunk-at-change-min)
+ (< change-max
+ (overlay-end chunk-at-change-min))
+ (or (not mumamo-last-chunk)
+ (> change-max (overlay-end mumamo-last-chunk))))
+ change-max))
+ (use-chunk-at-change-min (when (or (not mumamo-last-chunk)
+ (not (overlay-buffer mumamo-last-chunk))
+ (not chunk-at-change-min)
+ (not (overlay-buffer chunk-at-change-min))
+ (> (overlay-end chunk-at-change-min)
+ (overlay-end mumamo-last-chunk)))
+ chunk-at-change-min
+ )))
+ (setq this-new-values (mumamo-find-next-chunk-values
+ mumamo-last-chunk
+ first-check-from
+ use-change-max
+ use-chunk-at-change-min)))
+ (if (not this-new-values)
+ (setq ok-pos (point-max))
+ (setq first-check-from nil)
+ (setq ok-pos (or (mumamo-new-chunk-value-max this-new-values) ;;(overlay-end this-chunk)
+ (point-max)))
+ ;;(msgtrc "ok-pos=%s, point-max=%s max=%s" ok-pos (point-max) (mumamo-new-chunk-value-max this-new-values))
+ ;; With the new organization all chunks are created here.
+ (if (mumamo-old-tail-fits this-new-values)
+ (mumamo-reuse-old-tail-head)
+ (mumamo-delete-chunks-upto ok-pos)
+ ;; Create chunk and chunk links
+ (setq mumamo-last-chunk (mumamo-new-create-chunk this-new-values))
+ ;;(setq last-chunk-is-closed (overlay-get mumamo-last-chunk 'mumamo-is-closed))
+ (unless first-change-pos
+ (setq first-change-pos (mumamo-new-chunk-value-min this-new-values))))))
+ (setq this-new-chunk mumamo-last-chunk)))
+ (widen)
+ (when (or interrupted
+ (and mumamo-last-chunk
+ (overlayp mumamo-last-chunk)
+ (overlay-buffer mumamo-last-chunk)
+ (buffer-live-p (overlay-buffer mumamo-last-chunk))
+ (< (overlay-end mumamo-last-chunk) (point-max))))
+ (mumamo-start-find-chunks-timer)
+ )
+ (when first-change-pos
+ (setq jit-lock-context-unfontify-pos
+ (if jit-lock-context-unfontify-pos
+ (min jit-lock-context-unfontify-pos first-change-pos)
+ first-change-pos))))
+ (goto-char here)
+ (setq mumamo-find-chunk-is-active nil)))
+
+ ;; fix-me: continue here
+ (when chunk-at-change-min (mumamo-clear-chunk-ppss-cache chunk-at-change-min))
+ (setq mumamo-find-chunks-level (1- mumamo-find-chunks-level))
+ ;; Avoid empty overlays at the end of the buffer. Those can
+ ;; come from for example deleting to the end of the buffer.
+ (when this-new-chunk
+ ;; Fix-me: can this happen now?
+ (setq prev-chunk (overlay-get this-new-chunk 'mumamo-prev-chunk))
+ (when (and prev-chunk
+ (overlay-buffer prev-chunk)
+ (= (overlay-start this-new-chunk) (overlay-end this-new-chunk))
+ (= (overlay-start prev-chunk) (overlay-end prev-chunk)))
+ (overlay-put prev-chunk 'mumamo-next-chunk nil)
+ (overlay-put prev-chunk 'mumamo-prev-chunk nil)
+ ;;(msgtrc "find-chunks:deleting this-new-chunk %s" this-new-chunk)
+ (delete-overlay this-new-chunk)
+ (setq this-new-chunk prev-chunk)
+ )
+ (while (and mumamo-old-tail
+ (overlay-buffer mumamo-old-tail)
+ (= (overlay-start mumamo-old-tail) (overlay-end mumamo-old-tail)))
+ (assert (not (eq mumamo-old-tail (overlay-get mumamo-old-tail 'mumamo-next-chunk))) t)
+ (setq prev-chunk mumamo-old-tail)
+ (setq mumamo-old-tail (overlay-get mumamo-old-tail 'mumamo-next-chunk))
+ ;;(msgtrc "mumamo-find-chunks-1:after mumamo-old-tail=%s" mumamo-old-tail)
+ (delete-overlay prev-chunk)
+ )
+ )
+ ;;(unless (overlay-get mumamo-last-chunk 'mumamo-is-closed)
+ (unless t ;(= (overlay-end mumamo-last-chunk) (save-restriction (widen) (point-max)))
+ ;; Check that there are no left-over old chunks
+ (save-restriction
+ (widen)
+ (dolist (o (overlays-in (point-min) (point-max)))
+ (when (and (overlay-get o 'mumamo-depth)
+ (not (overlay-get o 'mumamo-is-new)))
+ (error "mumamo-find-chunks: left over chunk: %s end=%s, last-chunk=%s" o end mumamo-last-chunk)))))
+ (when end-param
+ ;;(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)
+ (let* ((ret this-new-chunk)
+ (ret-beg (overlay-start ret))
+ (ret-end (overlay-end ret)))
+ (unless (and (<= ret-beg end-param)
+ (<= end-param ret-end))
+ (error "mumamo-find-chunks: Bad ret=%s, end=%s" ret end-param))
+ ;;(msgtrc "find-chunks=>%S" ret)
+ ret))))))
+
+(defun mumamo-find-chunk-after-change (min max)
+ "Save change position after a buffer change.
+This should be run after a buffer change. For MIN see
+`after-change-functions'."
+ ;; Fix-me: Maybe use a list of all min, max instead?
+ (mumamo-start-find-chunks-timer)
+ ;;(msgtrc "(mumamo-find-chunk-after-change %s %s)" min max)
+ (setq min (copy-marker min nil))
+ (setq max (copy-marker max t))
+ (setq mumamo-last-change-pos
+ (if mumamo-last-change-pos
+ (let* ((old-min (car mumamo-last-change-pos))
+ (old-max (cdr mumamo-last-change-pos))
+ (new-min (min min old-min))
+ (new-max (max max old-max)))
+ (cons new-min new-max))
+ (cons min max))))
+
+(defun mumamo-after-change (min max old-len)
+ "Everything that needs to be done in mumamo after a change.
+This is run in the `after-change-functions' hook. For MIN, MAX
+and OLD-LEN see that variable."
+ ;;(msgtrc "mumamo-after-change BEGIN min/max/old-len=%s/%s/%s" min max old-len)
+ ;;(msgtrc "mumamo-after-change BEGIN")
+ (mumamo-find-chunk-after-change min max)
+ (mumamo-jit-lock-after-change min max old-len)
+ (mumamo-msgfntfy "mumamo-after-change EXIT")
+ ;;(msgtrc "mumamo-after-change EXIT mumamo-last-change-pos=%s" mumamo-last-change-pos)
+ )
+
+(defun mumamo-jit-lock-after-change (min max old-len)
+ ;; Fix-me: Should not this be on
+ ;; jit-lock-after-change-externd-region-functions??
+ "Replacement for `jit-lock-after-change'.
+Does the nearly the same thing as that function, but takes
+care of that there might be different major modes at MIN and MAX.
+It also marks for refontification only in the current mumamo chunk.
+
+OLD-LEN is the pre-change length.
+
+Jit-lock after change functions is organized this way:
+
+`jit-lock-after-change' (doc: Mark the rest of the buffer as not
+fontified after a change) is added locally to the hook
+`after-change-functions'. This function runs
+`jit-lock-after-change-extend-region-functions'."
+ (when (and jit-lock-mode (not memory-full))
+ (mumamo-msgfntfy "mumamo-jit-lock-after-change ENTER %s %s %s" min max old-len)
+ ;; Why is this nil?:
+ (mumamo-msgfntfy " mumamo-jit-lock-after-change: font-lock-extend-after-change-region-function=%s" font-lock-extend-after-change-region-function)
+ (let* ((ovl-min (mumamo-get-existing-new-chunk-at min nil))
+ (ovl-max (when (or (not ovl-min)
+ (< (overlay-end ovl-min) max))
+ (mumamo-get-existing-new-chunk-at max nil)))
+ (major-min (when ovl-min (mumamo-chunk-major-mode ovl-min)))
+ (major-max (when ovl-max (mumamo-chunk-major-mode ovl-max)))
+ (r-min nil)
+ (r-max nil)
+ (new-min min)
+ (new-max max))
+ (if (and major-min (eq major-min major-max))
+ (setq r-min
+ (when major-min
+ (mumamo-jit-lock-after-change-1 min max old-len major-min)))
+ (setq r-min
+ (when major-min
+ (mumamo-jit-lock-after-change-1 min max old-len major-min)))
+ (setq r-max
+ (when major-max
+ (mumamo-jit-lock-after-change-1 min max old-len major-max))))
+ (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)
+ (when r-min
+ (setq new-min (min new-min (car r-min)))
+ (setq new-max (max new-max (cdr r-min))))
+ (when r-max
+ (setq new-min (min new-min (car r-max)))
+ (setq new-max (max new-max (cdr r-max))))
+ (setq new-min (max new-min (point-min)))
+ (setq new-max (min new-max (point-max)))
+ ;; Make sure we change at least one char (in case of deletions).
+ (setq new-max (min (max new-max (1+ new-min)) (point-max)))
+ (mumamo-msgfntfy "mumamo-jit-lock-after-change new-min,max=%s,%s" new-min new-max)
+ (mumamo-mark-for-refontification new-min new-max)
+
+ ;; Mark the change for deferred contextual refontification.
+ ;;(setq jit-lock-context-unfontify-pos nil) (setq message-log-max t)
+ (when jit-lock-context-unfontify-pos
+ (setq jit-lock-context-unfontify-pos
+ ;; Here we use `start' because nothing guarantees that the
+ ;; text between start and end will be otherwise refontified:
+ ;; usually it will be refontified by virtue of being
+ ;; displayed, but if it's outside of any displayed area in the
+ ;; buffer, only jit-lock-context-* will re-fontify it.
+ (min jit-lock-context-unfontify-pos new-min))
+ ;;(with-current-buffer (get-buffer "*Messages*") (erase-buffer))
+ (mumamo-msgfntfy "mumamo-jit-lock-after-change EXIT unfontify-pos=%s" jit-lock-context-unfontify-pos)
+ ;;(message "mumamo-jit-lock-after-change.unfontify-pos=%s" jit-lock-context-unfontify-pos)
+ ))))
+;;(min jit-lock-context-unfontify-pos jit-lock-start))))))
+;;(put 'mumamo-jit-lock-after-change 'permanent-local-hook t)
+(put 'mumamo-after-change 'permanent-local-hook t)
+
+(defun mumamo-jit-lock-after-change-1 (min max old-len major)
+ "Extend the region the same way jit-lock does it.
+This function tries to extend the region between MIN and MAX the
+same way jit-lock does it after a change. OLD-LEN is the
+pre-change length.
+
+The extending of the region is done as if MAJOR was the major
+mode."
+ (mumamo-with-major-mode-fontification major
+ `(progn
+ (let ((jit-lock-start ,min)
+ (jit-lock-end ,max))
+ ;;(mumamo-msgfntfy "mumamo-mumamo-jit-lock-after-change-1 jlacer=%s" ,jit-lock-after-change-extend-region-functions)
+ (mumamo-with-buffer-prepared-for-jit-lock
+ ;;(font-lock-extend-jit-lock-region-after-change ,min ,max ,old-len)
+ (run-hook-with-args 'jit-lock-after-change-extend-region-functions min max old-len)
+ ;;(setq jit-lock-end (min (max jit-lock-end (1+ min)) (point-max)))
+
+;;; ;; Just run the buffer local function:
+;;; (dolist (extend-fun jit-lock-after-change-extend-region-functions)
+;;; (when (fboundp extend-fun)
+;;; (funcall extend-fun ,min ,max ,old-len)))
+ )
+ (setq min jit-lock-start)
+ (setq max jit-lock-end)
+ ;;(syntax-ppss-flush-cache min)
+ )))
+ (mumamo-msgfntfy "mumamo-mumamo-jit-lock-after-change-1 EXIT %s" (cons min max))
+ (cons min max))
+
+(defun mumamo-mark-chunk ()
+ "Mark chunk and move point to beginning of chunk."
+ (interactive)
+ (let ((chunk (mumamo-find-chunks (point) "mumamo-mark-chunk")))
+ (unless chunk (error "There is no MuMaMo chunk here"))
+ (goto-char (overlay-start chunk))
+ (push-mark (overlay-end chunk) t t)))
+
+(defun mumamo-narrow-to-chunk-inner ()
+ (interactive)
+ (let* ((chunk (mumamo-find-chunks (point) "mumamo-narrow-to-chunk-innner"))
+ (syntax-min-max (mumamo-chunk-syntax-min-max chunk t))
+ (syntax-min (car syntax-min-max))
+ (syntax-max (cdr syntax-min-max)))
+ (narrow-to-region syntax-min syntax-max)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Font lock functions
+
+(defadvice hi-lock-set-pattern (around use-overlays activate)
+ (if mumamo-multi-major-mode
+ (let ((font-lock-fontified nil))
+ ad-do-it)
+ ad-do-it))
+
+;;;###autoload
+(defun mumamo-mark-for-refontification (min max)
+ "Mark region between MIN and MAX for refontification."
+ ;;(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) )
+ ;;(mumamo-backtrace "mark-for-refontification")
+ (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) )
+ (assert (<= min max))
+ (when (< min max)
+ (save-restriction
+ (widen)
+ (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) )
+ ;;(mumamo-with-buffer-prepared-for-jit-lock
+ (mumamo-save-buffer-state nil
+ (put-text-property min max 'fontified nil)
+ ))))
+
+
+;; Fix me: The functions in this list must be replaced by variables
+;; pointing to anonymous functions for buffer local values of
+;; fontification keywords to be supported. And that is of course
+;; necessary for things like hi-lock etc. (Or..., perhaps some kind of
+;; with-variable-values... as RMS suggested once... but that will not
+;; help here...)
+;;
+;; Seems like font-lock-add-keywords must be advised...
+(defvar mumamo-internal-major-modes-alist nil
+ "Alist with info for different major modes.
+Internal use only. This is automatically set up by
+`mumamo-get-major-mode-setup'.")
+(setq mumamo-internal-major-modes-alist nil)
+(put 'mumamo-internal-major-modes-alist 'permanent-local t)
+
+(defvar mumamo-ppss-last-chunk nil
+ "Internal variable used to avoid unnecessary flushing.")
+(defvar mumamo-ppss-last-major nil
+ "Internal variable used to avoid unnecessary flushing.")
+
+;;(mumamo-get-major-mode-substitute 'nxhtml-mode 'fontification)
+;;(mumamo-get-major-mode-substitute 'nxhtml-mode 'indentation)
+;;(mumamo-get-major-mode-substitute 'css-mode 'fontification)
+;;(mumamo-get-major-mode-substitute 'css-mode 'indentation)
+;; (assq 'nxml-mode mumamo-major-mode-substitute)
+(defconst mumamo-major-mode-substitute
+ '(
+ (nxhtml-mode (html-mode nxhtml-mode))
+ ;;(nxhtml-mode (html-mode))
+ (nxhtml-genshi-mode (html-mode nxhtml-mode))
+ (nxhtml-mjt-mode (html-mode nxhtml-mode))
+ (nxml-mode (sgml-mode))
+ )
+ "Major modes substitute to use for fontification and indentation.
+The entries in this list has either of the formats
+
+ \(MAJOR (FONT-MODE INDENT-MODE))
+ \(MAJOR (FONT-MODE))
+
+where major is the major mode in a mumamo chunk and FONT-MODE is
+the major mode for fontification of that chunk and INDENT-MODE is
+dito for indentation. In the second form the same mode is used
+for indentation as for fontification.")
+
+;;(mumamo-get-major-mode-substitute 'nxhtml-mode 'indentation)
+;;(mumamo-get-major-mode-substitute 'nxhtml-mode 'fontification)
+(defun mumamo-get-major-mode-substitute (major for-what)
+ "For major mode MAJOR return major mode to use for FOR-WHAT.
+FOR-WHAT can be either 'fontification or indentation.
+
+mumamo must handle fontification and indentation for `major-mode'
+by using other major mode if the functions for this in
+`major-mode' are not compatible with mumamo. This functions
+looks in the table `mumamo-major-mode-substitute' for get major
+mode to use."
+ ;;(when (eq for-what 'indentation) (message "subst.major=%s" major))
+ (let ((m (assq major mumamo-major-mode-substitute))
+ ret-major)
+ (if (not m)
+ (setq ret-major major)
+ (setq m (nth 1 m))
+ (setq ret-major
+ (cond
+ ((eq for-what 'fontification)
+ (nth 0 m))
+ ((eq for-what 'indentation)
+ (nth 1 m))
+ (t
+ (mumamo-display-error 'mumamo-get-major-mode-substitute
+ "Bad parameter, for-what=%s" for-what))))
+ (unless ret-major (setq ret-major major)))
+ (unless (commandp ret-major) (setq ret-major 'mumamo-bad-mode))
+ ;;(when (eq for-what 'indentation) (message "ret.ind=%s, major=%s, m=%s" ret major m))
+ ret-major))
+
+(defun mumamo-assert-fontified-t (start end)
+ "Assert that the region START to END has 'fontified t."
+ (let ((start-ok (get-text-property start 'fontified))
+ (first-not-ok
+ (next-single-property-change (1+ start) 'fontified nil end)))
+ (when (not start-ok)
+ (message "==== mumamo-assert-fontified-t %s-%s start not ok" start end))
+ (when (not (= first-not-ok end))
+ (message "==== mumamo-assert-fontified-t %s-%s first not ok=%s" start end first-not-ok))))
+
+;; Keep this separate for easier debugging.
+(defun mumamo-do-fontify (start end verbose chunk-syntax-min chunk-syntax-max chunk-major)
+ "Fontify region between START and END.
+If VERBOSE is non-nil then print status messages during
+fontification.
+
+CHUNK-SYNTAX-MIN, CHUNK-SYNTAX-MAX and CHUNK-MAJOR are the
+chunk's min point, max point and major mode.
+
+During fontification narrow the buffer to the chunk to make
+syntactic fontification work. If chunks starts or end with \"
+then the first respective last char then exclude those chars from
+from the narrowed part, since otherwise the syntactic
+fontification can't find out where strings start and stop.
+
+Note that this function is run under
+`mumamo-with-major-mode-fontification'.
+
+This function takes care of `font-lock-dont-widen' and
+`font-lock-extend-region-functions'. Normally
+`font-lock-default-fontify-region' does this, but that function
+is not called when mumamo is used!
+
+PS: `font-lock-fontify-syntactically-region' is the main function
+that does syntactic fontification."
+ ;;(msgtrc "mumamo-do-fontify enter: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
+ ;;(msgtrc "mumamo-do-fontify <<<<<<< %s %s %s %s %s %s" start end verbose chunk-syntax-min chunk-syntax-max chunk-major)
+ ;;(msgtrc "font-lock-keywords=%S" font-lock-keywords)
+ ;;(mumamo-assert-fontified-t start end)
+ (mumamo-condition-case err
+ (let* ((font-lock-dont-widen t)
+ (font-lock-extend-region-functions
+ ;; nil
+ font-lock-extend-region-functions
+ )
+ ;; Extend like in `font-lock-default-fontify-region':
+ (funs font-lock-extend-region-functions)
+ (font-lock-beg (max chunk-syntax-min start))
+ (font-lock-end (min chunk-syntax-max end))
+ (while-n1 0))
+ ;;(while (and (> 500 (setq while-n1 (1+ while-n1)))
+ (while (and (mumamo-while 500 'while-n1 "funs")
+ funs)
+ (setq funs (if (or (not (funcall (car funs)))
+ (eq funs font-lock-extend-region-functions))
+ (cdr funs)
+ ;; If there's been a change, we should go through
+ ;; the list again since this new position may
+ ;; warrant a different answer from one of the fun
+ ;; we've already seen.
+ font-lock-extend-region-functions)))
+ ;; But we must restrict to the chunk here:
+ (let ((new-start (max chunk-syntax-min font-lock-beg))
+ (new-end (min chunk-syntax-max font-lock-end)))
+ ;;(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)
+ ;; A new condition-case just to catch errors easier:
+ (when (< new-start new-end)
+ (mumamo-condition-case err
+ (save-restriction
+ ;;(when (and (>= 625 (point-min)) (<= 625 (point-max))) (msgtrc "multi at 625=%s" (get-text-property 625 'font-lock-multiline)))
+ ;;(msgtrc "(narrow-to-region %s %s)" chunk-syntax-min chunk-syntax-max)
+ (when (< chunk-syntax-min chunk-syntax-max)
+ (narrow-to-region chunk-syntax-min chunk-syntax-max)
+ ;; Now call font-lock-fontify-region again but now
+ ;; with the chunk font lock parameters:
+ (setq font-lock-syntactically-fontified (1- new-start))
+ (mumamo-msgfntfy "ENTER font-lock-fontify-region %s %s %s" new-start new-end verbose)
+ ;;(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))
+ (let (font-lock-extend-region-functions)
+ (font-lock-fontify-region new-start new-end verbose))
+ (mumamo-msgfntfy "END font-lock-fontify-region %s %s %s" new-start new-end verbose)
+ )
+ )
+ (error
+ (mumamo-display-error 'mumamo-do-fontify-2
+ "mumamo-do-fontify m=%s, s/e=%s/%s syn-min/max=%s/%s: %s"
+ chunk-major
+ start end
+ chunk-syntax-min chunk-syntax-max
+ (error-message-string err)))))))
+ (error
+ (mumamo-display-error 'mumamo-do-fontify
+ "mumamo-do-fontify m=%s, s=%s, e=%s: %s"
+ chunk-major start end (error-message-string err)))
+ )
+ (mumamo-msgfntfy "mumamo-do-fontify exit >>>>>>> %s %s %s %s %s %s" start end verbose chunk-syntax-min chunk-syntax-max chunk-major)
+ ;;(msgtrc "mumamo-do-fontify exit: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
+ )
+
+(defun mumamo-do-unfontify (start end)
+ "Unfontify region between START and END."
+ (mumamo-condition-case err
+ (font-lock-unfontify-region start end)
+ (error
+ (mumamo-display-error 'mumamo-do-unfontify "%s"
+ (error-message-string err)))))
+
+(defun mumamo-fontify-region-with (start end verbose major chunk-syntax-min chunk-syntax-max)
+ "Fontify from START to END.
+If VERBOSE is non-nil then print status messages during
+fontification.
+
+Do the fontification as in major mode MAJOR.
+
+Narrow to region CHUNK-SYNTAX-MIN and CHUNK-SYNTAX-MAX during
+fontification."
+ ;; The text property 'fontified is always t here due to the way
+ ;; jit-lock works!
+
+ ;;(msgtrc "fontify-region-with %s %s %s %s, ff=%s" start end verbose major (get-text-property start 'fontified))
+ ;;(mumamo-assert-fontified-t start end)
+ ;;(msgtrc "mumamo-fontify-region-with enter: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
+ (mumamo-condition-case err
+ (progn
+ ;;(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))
+ (mumamo-with-major-mode-fontification major
+ `(mumamo-do-fontify ,start ,end ,verbose ,chunk-syntax-min ,chunk-syntax-max major))
+ )
+ (error
+ (mumamo-display-error 'mumamo-fontify-region-with "%s"
+ (error-message-string err))))
+ ;;(msgtrc "mumamo-fontify-region-with exit: font-lock-keywords-only def=%s" (default-value 'font-lock-keywords-only))
+ )
+
+(defun mumamo-unfontify-region-with (start end major)
+ "Unfontify from START to END as in major mode MAJOR."
+ (mumamo-msgfntfy "mumamo-unfontify-region-with %s %s %s, ff=%s"
+ start
+ end
+ major
+ (when start
+ (save-restriction
+ (widen)
+ (get-text-property start 'fontified))))
+ (mumamo-with-major-mode-fontification major
+ `(mumamo-do-unfontify ,start ,end)))
+
+
+
+(defun mumamo-backtrace (label)
+ (msgtrc "%s:backtrace in START buffer %s <<<<<<<<<<<<<<<<<<<<<<<<<<<<<<\n%s"
+ label (current-buffer) (with-output-to-string (backtrace)))
+ (msgtrc "%s:backtrace in END buffer %s >>>>>>>>>>>>>>>>>>>>>>>>>>>>>>" label (current-buffer)))
+
+(defun mumamo-unfontify-buffer ()
+ "Unfontify buffer.
+This function is called when the minor mode function
+`font-lock-mode' is turned off. \(It is the value of
+`font-lock-unfontify-uffer-function')."
+ (when (and mumamo-multi-major-mode
+ (not (and (boundp 'mumamo-find-chunks-1-active)
+ mumamo-find-chunks-1-active)))
+ ;;(mumamo-backtrace "unfontify-buffer")
+ ;;(msgtrc "mumamo-unfontify-buffer:\n%s" (with-output-to-string (backtrace)))
+ (save-excursion
+ (save-restriction
+ (widen)
+ (let ((ovls (overlays-in (point-min) (point-max)))
+ (main-major (mumamo-main-major-mode)))
+ (dolist (o ovls)
+ (when (overlay-get o 'mumamo-is-new)
+ (let ((major (mumamo-chunk-major-mode o)))
+ (when major
+ (unless (mumamo-fun-eq major main-major)
+ (mumamo-unfontify-chunk o))
+ ;;(msgtrc "delete-overlay 1")
+ (delete-overlay o)
+ ))))
+ (mumamo-unfontify-region-with (point-min) (point-max)
+ (mumamo-main-major-mode)))))))
+
+
+(defun mumamo-fontify-buffer ()
+ "For `font-lock-fontify-buffer-function' call.
+Not sure when this normally is done. However some functions call
+this to ensure that the whole buffer is fontified."
+ (mumamo-msgfntfy "===> mumamo-fontify-buffer-function called")
+ ;;(font-lock-default-fontify-buffer)
+ (unless mumamo-set-major-running
+ ;; This function is normally not called, but when new patterns
+ ;; have been added by hi-lock it will be called. In this case we
+ ;; need to make buffer local fontification variables:
+ (set (make-local-variable 'mumamo-internal-major-modes-alist) nil)
+ (jit-lock-refontify)))
+
+
+(defun mumamo-unfontify-chunk (chunk) ; &optional start end)
+ "Unfontify mumamo chunk CHUNK."
+ (let* ((major (mumamo-chunk-major-mode chunk))
+ ;;(start (overlay-start chunk))
+ ;;(end (overlay-end chunk))
+ (syntax-min-max (mumamo-chunk-syntax-min-max chunk t))
+ (syntax-min (car syntax-min-max))
+ (syntax-max (cdr syntax-min-max))
+ (font-lock-dont-widen t))
+ (when (< syntax-min syntax-max)
+ (save-restriction
+ (narrow-to-region syntax-min syntax-max)
+ (mumamo-unfontify-region-with syntax-min syntax-max major)))))
+
+(defun mumamo-fontify-region (start end &optional verbose)
+ "Fontify between START and END.
+Take the major mode chunks into account while doing this.
+
+If VERBOSE do the verbously.
+
+The value of `font-lock-fontify-region-function' when
+mumamo is used is this function."
+ (mumamo-msgfntfy "++++++ mumamo-fontify-regionX %s %s %s, skip=%s" start end verbose mumamo-just-changed-major)
+ ;;(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))
+ ;;(mumamo-assert-fontified-t start end)
+ ;; If someone else tries to fontify the buffer ...
+ (if (and mumamo-just-changed-major
+ ;; The above variable is reset in `post-command-hook' so
+ ;; check if we are in a recursive search. (Note: There are
+ ;; other situation when this can occur. It might be best to
+ ;; remove this test later, or make it optional.)
+ ;;
+ ;; skip the test for now:
+ nil
+ (= 0 (recursion-depth)))
+ (mumamo-display-error 'mumamo-fontify-region
+ "Just changed major, should not happen")
+ (mumamo-condition-case err
+ (mumamo-fontify-region-1 start end verbose)
+ (error
+ (mumamo-display-error 'mumamo-fontify-region "%s"
+ (error-message-string err))))))
+
+(defconst mumamo-dbg-pretend-fontified nil
+ "Set this to t to be able to debug more easily.
+This is for debugging `mumamo-fontify-region-1' more easily by
+just calling it. It will make that function believe that the text
+has a non-nil 'fontified property.")
+
+(defun mumamo-exc-mode (chunk)
+ "Return sub major mode for CHUNK.
+If chunk is a main major mode chunk return nil, otherwise return
+the major mode for the chunk."
+ (let ((major (mumamo-chunk-major-mode chunk)))
+ (unless (mumamo-fun-eq major (mumamo-main-major-mode))
+ major)))
+
+;;; Chunk in chunk needs push/pop relative prev chunk
+(defun mumamo-chunk-push (chunk prop val)
+ (let* ((prev-chunk (overlay-get chunk 'mumamo-prev-chunk))
+ (prev-val (when prev-chunk (overlay-get prev-chunk prop))))
+ (overlay-put chunk prop (cons val prev-val))))
+(defun mumamo-chunk-pop (chunk prop)
+ (overlay-put chunk prop (cdr (overlay-get (overlay-get chunk 'mumamo-prev-chunk)
+ prop))))
+
+;; (defvar mumamo-chunks-to-remove nil
+;; "Internal. Chunk overlays marked for removal.")
+;; (make-variable-buffer-local 'mumamo-chunks-to-remove)
+
+(defun mumamo-flush-chunk-syntax (chunk chunk-min chunk-max)
+ "Flush syntax cache for chunk CHUNK.
+This includes removing text property 'syntax-table between
+CHUNK-MIN and CHUNK-MAX."
+ ;; syntax-ppss-flush-cache
+ (overlay-put chunk 'syntax-ppss-last nil)
+ (overlay-put chunk 'syntax-ppss-cache nil)
+ (overlay-put chunk 'syntax-ppss-stats nil)
+ (mumamo-save-buffer-state nil
+ (remove-list-of-text-properties chunk-min chunk-max '(syntax-table))))
+
+;; Fix-me: If I open nxhtml-changes.html and then go to the bottom of
+;; the file at once syntax-ppss seems to be upset. It is however cured
+;; by doing some change above the region that is badly fontified.
+(defun mumamo-fontify-region-1 (start end verbose)
+ "Fontify region between START and END.
+If VERBOSE is non-nil then print status messages during
+fontification.
+
+This is called from `mumamo-fontify-region' which is the value of
+`font-lock-fontify-region-function' when mumamo is used. \(This
+means that it ties into the normal font lock framework in Emacs.)
+
+Note: The purpose of extracting this function from
+`mumamo-fontify-region' \(which is the only place where it is
+called) is to make debugging easier. Edebug will without this
+function just step over the `condition-case' in
+`mumamo-fontify-region'.
+
+The fontification is done in steps:
+
+- First a mumamo chunk is found or created at the start of the
+ region with `mumamo-get-chunk-at'.
+- Then this chunk is fontified according to the major mode for
+ that chunk.
+- If the chunk did not encompass the whole region then this
+ procedure is repeated with the rest of the region.
+
+If some mumamo chunk in the region between START and END has been
+marked for removal \(for example by `mumamo-jit-lock-after-change') then
+they are removed by this function.
+
+For some main major modes \(see `define-mumamo-multi-major-mode') the
+main major modes is first used to fontify the whole region. This
+is because otherwise the fontification routines for that mode may
+have trouble finding the correct starting state in a chunk.
+
+Special care has been taken for chunks that are strings, ie
+surrounded by \"...\" since they are fontified a bit special in
+most major modes."
+ ;; Fix-me: unfontifying should be done using the correct syntax table etc.
+ ;; Fix-me: refontify when new chunk
+ ;;(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))
+ (save-match-data
+ (let* ((old-point (point))
+ (here start)
+ (main-major (mumamo-main-major-mode))
+ (fontified-t ;;(or mumamo-dbg-pretend-fontified
+ ;; (get-text-property here 'fontified))
+ t)
+ after-change-functions ;; Fix-me: tested adding this to avoid looping
+ (first-new-ovl nil)
+ (last-new-ovl nil)
+ (chunk-at-start-1 (mumamo-find-chunks start "mumamo-fontify-region-1"))
+ (while-n1 0)
+ )
+ (when chunk-at-start-1
+ (unless (= start (1- (overlay-end chunk-at-start-1)))
+ (setq chunk-at-start-1 nil)))
+ ;;(while (and (> 500 (setq while-n1 (1+ while-n1)))
+ (while (and (mumamo-while 9000 'while-n1 "fontified-t")
+ fontified-t
+ (< here end))
+ ;;(msgtrc "mumamo-fontify-region-1 heree 1, here=%s, end=%s" here end)
+ ;;(mumamo-assert-fontified-t here end)
+ ;;(mumamo-assert-fontified-t start end)
+ ;; Check where new chunks should be, adjust old chunks as
+ ;; necessary. Refontify inside end-start and outside of
+ ;; start-end mark for refontification when major-mode has
+ ;; changed or there was no old chunk.
+ ;;
+ ;; Fix-me: Join chunks!
+ (let* ((chunk (mumamo-find-chunks here "mumamo-fontify-region-1 2"))
+ (chunk-min (when chunk (overlay-start chunk)))
+ (chunk-max (when chunk (overlay-end chunk)))
+ (chunk-min-1 (when chunk (if (> chunk-min (point-min)) (1- chunk-min) (point-min))))
+ (chunk-max-1 (when chunk (if (< chunk-max (point-max)) (1+ chunk-max) (point-max))))
+ (chunk-min-face (when chunk (get-text-property chunk-min-1 'face)))
+ (chunk-max-face (when chunk (get-text-property chunk-max-1 'face)))
+ (chunk-major (when chunk (mumamo-chunk-major-mode chunk)))
+ max ; (min chunk-max end))
+ )
+ (assert chunk)
+
+ (setq chunk-min (when chunk (overlay-start chunk)))
+ (setq chunk-max (when chunk (overlay-end chunk)))
+ (setq chunk-min-1
+ (when chunk
+ (if (> chunk-min (point-min)) (1- chunk-min) (point-min)))) ;chunk-min
+ (setq chunk-max-1
+ (when chunk
+ (if (< chunk-max (point-max)) (1+ chunk-max) (point-max)))) ;chunk-max
+ (setq chunk-min-face
+ (when chunk (get-text-property chunk-min-1 'face)))
+ (setq chunk-max-face
+ (when chunk (get-text-property chunk-max-1 'face)))
+ (setq chunk-major (when chunk (mumamo-chunk-major-mode chunk)))
+
+ (if (and first-new-ovl (overlay-buffer first-new-ovl))
+ (setq last-new-ovl chunk)
+ (setq last-new-ovl chunk)
+ (setq first-new-ovl chunk))
+ ;;(mumamo-assert-fontified-t chunk-min chunk-max)
+
+ (setq max (min chunk-max end))
+
+ (assert chunk) (assert (overlay-buffer chunk)) (assert chunk-min)
+ (assert chunk-max) (assert chunk-major)
+ ;; Fix-me: The next assertion sometimes fails. Could it be
+ ;; that this loop is continuing even after a change in the
+ ;; buffer? How do I stop that? When?:
+ ;;(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)
+ ;;(assert (not (mumamo-fun-eq prev-major chunk-major)))
+ ;;(when prev-chunk
+ ;; (assert (= (overlay-end prev-chunk) (overlay-start chunk))))
+
+ ;; Fontify
+ ;;(msgtrc "\nmumamo-fontify-region-1 before chunk=%s" chunk)
+ (mumamo-update-obscure chunk here)
+ (let* ((syntax-min-max (mumamo-chunk-syntax-min-max chunk nil))
+ (syntax-min (car syntax-min-max))
+ (syntax-max (cdr syntax-min-max))
+ (chunk-min (overlay-start chunk))
+ (chunk-max (overlay-end chunk))
+ (border-min-max (mumamo-chunk-syntax-min-max chunk t))
+ (border-min (car border-min-max))
+ (border-max (cdr border-min-max))
+ )
+ ;;(msgtrc "fontify-region-1:syntax-min-max=%S, chunk=%S" syntax-min-max chunk)
+ ;;(msgtrc "chunk mumamo-border-face: %s" chunk)
+ (mumamo-msgfntfy "mumamo-fontify-region-1, here=%s chunk-min=%s syn-mn/mx=%s/%s" here chunk-min syntax-min syntax-max)
+ (when (<= here syntax-min)
+ (mumamo-flush-chunk-syntax chunk syntax-min syntax-max))
+ (when (and (<= here syntax-min)
+ (< chunk-min border-min))
+ ;;(msgtrc "face-in: %s-%s" chunk-min border-min)
+ (put-text-property chunk-min border-min 'face 'mumamo-border-face-in)
+ )
+ (when (and (<= chunk-max max)
+ ;;(< (1+ border-max) chunk-max))
+ (< border-max chunk-max))
+ ;;(put-text-property (1+ border-max) chunk-max
+ (put-text-property border-max chunk-max
+ 'face 'mumamo-border-face-out))
+ (mumamo-fontify-region-with here max verbose chunk-major
+ syntax-min syntax-max))
+
+ ;;(setq prev-major chunk-major)
+ ;;(setq prev-chunk chunk)
+ (setq here (if (= max here) (1+ max) max))
+ ;;(setq fontified-t (or mumamo-dbg-pretend-fontified (get-text-property (1- here) 'fontified)))
+ )
+ ;;(msgtrc "ft here end=%s %s %s" fontified-t here end)
+ )
+ (goto-char old-point)
+ ;;(msgtrc "b first-new-ovl=%s last-new-ovl=%s" first-new-ovl last-new-ovl)
+ (unless fontified-t
+ ;; Fix-me: I am not sure what to do here. Probably just
+ ;; refontify the rest between start and end. But does not
+ ;; this lead to unnecessary refontification?
+ ;;(msgtrc "not sure, here=%s, end=%s" here end)
+ (unless (= here (point-max))
+ (mumamo-mark-for-refontification here end)))
+ ))
+ ;;(msgtrc "EXIT mumamo-fontify-region-1")
+ )
+
+
+(defvar mumamo-known-buffer-local-fontifications
+ '(
+ font-lock-mode-hook
+ ;;
+ css-color-mode
+ hi-lock-mode
+ hi-lock-file-patterns
+ hi-lock-interactive-patterns
+ wrap-to-fill-column-mode
+ ))
+
+(defconst mumamo-irrelevant-buffer-local-vars
+ '(
+ ;; This list was fetched with
+ ;; emacs-Q, fundamental-mode
+ after-change-functions
+ ;;auto-composition-function
+ ;;auto-composition-mode
+ ;;auto-composition-mode-major-mode
+ buffer-auto-save-file-format
+ buffer-auto-save-file-name
+ buffer-backed-up
+ buffer-display-count
+ buffer-display-time
+ buffer-file-format
+ buffer-file-name
+ buffer-file-truename
+ buffer-invisibility-spec
+ buffer-read-only
+ buffer-saved-size
+ buffer-undo-list
+ change-major-mode-hook
+ ;;char-property-alias-alist
+ cursor-type
+ default-directory
+ delay-mode-hooks
+ enable-multibyte-characters
+ ;;font-lock-mode
+ ;;font-lock-mode-major-mode
+ ;;major-mode
+ mark-active
+ mark-ring
+ mode-name
+ point-before-scroll
+ ;; Handled by font lock etc
+ font-lock-defaults
+ font-lock-fontified
+ font-lock-keywords
+ ;;font-lock-keywords-only
+ font-lock-keywords-case-fold-search
+ font-lock-mode
+ ;;font-lock-mode-major-mode
+ font-lock-set-defaults
+ font-lock-syntax-table
+ font-lock-beginning-of-syntax-function
+ fontification-functions
+ jit-lock-context-unfontify-pos
+ jit-lock-mode
+ ;; Mumamo
+ font-lock-fontify-buffer-function
+ jit-lock-contextually
+ jit-lock-functions
+ ;; More symbols from visual inspection
+ before-change-functions
+ delayed-mode-hooks
+ isearch-mode
+ line-move-ignore-invisible
+ local-abbrev-table
+ ;;syntax-ppss-last
+ ;;syntax-ppss-cache
+
+ ;; Cua
+ cua--explicit-region-start
+ ;; Viper
+ viper--intercept-key-maps
+ viper--key-maps
+ viper-ALPHA-char-class
+ viper-current-state
+ viper-emacs-global-user-minor-mode
+ viper-emacs-intercept-minor-mode
+ viper-emacs-kbd-minor-mode
+ viper-emacs-local-user-minor-mode
+ viper-emacs-state-modifier-minor-mode
+ viper-insert-basic-minor-mode
+ viper-insert-diehard-minor-mode
+ viper-insert-global-user-minor-mode
+ viper-insert-intercept-minor-mode
+ viper-insert-kbd-minor-mode
+ viper-insert-local-user-minor-mode
+ viper-insert-minibuffer-minor-mode
+ viper-insert-point
+ viper-insert-state-modifier-minor-mode
+ viper-intermediate-command
+ viper-last-posn-while-in-insert-state
+ viper-minibuffer-current-face
+ viper-mode-string
+ viper-non-word-characters
+ viper-replace-minor-mode
+ viper-replace-overlay
+ viper-undo-functions
+ viper-undo-needs-adjustment
+ viper-vi-basic-minor-mode
+ viper-vi-diehard-minor-mode
+ viper-vi-global-user-minor-mode
+ viper-vi-intercept-minor-mode
+ viper-vi-kbd-minor-mode
+ viper-vi-local-user-minor-mode
+ viper-vi-minibuffer-minor-mode
+ viper-vi-state-modifier-minor-mode
+ ;; hs minor mode
+ hs-adjust-block-beginning
+ hs-block-start-mdata-select
+ hs-block-start-regexp
+ hs-c-start-regexp
+ hs-forward-sexp-func
+ hs-minor-mode
+ ;; Imenu
+ imenu-case-fold-search
+ imenu-generic-expression
+ ;; Fix-me: add more here
+ ))
+
+(defun mumamo-get-relevant-buffer-local-vars ()
+ "Get list of buffer local variables to save.
+Like `buffer-local-variables', but remove variables that are
+known to not be necessary to save for fontification, indentation
+or filling \(or that can even disturb things)."
+ (let (var-vals)
+ (dolist (vv (buffer-local-variables))
+ (unless (or (not (listp vv))
+ (memq (car vv) mumamo-irrelevant-buffer-local-vars)
+ (let* ((sym (car vv))
+ (val (symbol-value sym)))
+ (or (markerp val)
+ (overlayp val))))
+ (let ((ent (list (car vv) (custom-quote (cdr vv)))))
+ (setq var-vals (cons ent var-vals)))))
+ ;; Sorting is for debugging/testing
+ (setq var-vals (sort var-vals
+ (lambda (a b)
+ (string< (symbol-name (car a))
+ (symbol-name (car b))))))
+ var-vals))
+
+(defvar mumamo-major-modes-local-maps nil
+ "An alist with major mode and local map.
+An entry in the list looks like
+
+ \(MAJOR-MODE LOCAL-KEYMAP)")
+
+;; (defun mumamo-font-lock-keyword-hook-symbol (major)
+;; "Return hook symbol for adding font-lock keywords to MAJOR."
+;; (intern (concat "mumamo-" (symbol-name major) "-font-lock-keyword-hook")))
+
+;; (defun mumamo-remove-font-lock-hook (major setup-fun)
+;; "For mode MAJOR remove function SETUP-FUN.
+;; See `mumamo-add-font-lock-hook' for more information."
+;; (remove-hook (mumamo-font-lock-keyword-hook-symbol major) setup-fun))
+
+(defun mumamo-refresh-multi-font-lock (major)
+ "Refresh font lock information for mode MAJOR in chunks.
+If multi fontification functions for major mode MAJOR is already
+setup up they will be refreshed.
+
+If MAJOR is nil then all font lock information for major modes
+used in chunks will be refreshed.
+
+After calling font-lock-add-keywords or changing the
+fontification in other ways you must call this function for the
+changes to take effect. However already fontified buffers will
+not be refontified. You can use `normal-mode' to refontify
+them.
+
+Fix-me: Does not work yet."
+
+ (setq mumamo-internal-major-modes-alist
+ (if (not major)
+ nil
+ (assq-delete-all major mumamo-internal-major-modes-alist))))
+
+;; RMS had the following idea:
+;;
+;; Suppose we add a Lisp primitive to bind a set of variables under
+;; the control of an alist. Would it be possible to eliminate these
+;; helper functions and use that primitive instead?
+;;
+;;; But wouldn't it be better to test this version first? There is
+;;; no hurry, this version works and someone might find that there
+;;; is a better way to do this than with helper functions.
+;;
+;; OK with me, as long as this point doesn't get forgotten.
+(defun mumamo-fetch-major-mode-setup (major keywords mode-keywords add-keywords how)
+ "Return a helper function to do fontification etc like in major mode MAJOR.
+Fetch the variables affecting font locking, indentation and
+filling by calling the major mode MAJOR in a temporary buffer.
+
+Make a function with one parameter BODY which is elisp code to
+eval. The function should let bind the variables above, sets the
+syntax table temporarily to the one used by the major mode
+\(using the mode symbol name to find it) and then evaluates body.
+
+Name this function mumamo-eval-in-MAJOR. Put the code for this
+function in the property `mumamo-defun' on this function symbol.
+
+
+** Some notes about background etc.
+
+The function made here is used in `mumamo-with-major-mode-setup'.
+The code in the function parameter BODY is typically involved in
+fontification, indentation or filling.
+
+The main reasons for doing it this way is:
+
+- It is faster and than setting the major mode directly.
+- It does not affect buffer local variables."
+ ;; (info "(elisp) Other Font Lock Variables")
+ ;; (info "(elisp) Syntactic Font Lock)
+ ;;(msgtrc "fetch-major 1: font-lock-keywords-only =%s" font-lock-keywords-only)
+ (let ((func-sym (intern (concat "mumamo-eval-in-" (symbol-name major))))
+ (func-def-sym (intern (concat "mumamo-def-eval-in-" (symbol-name major))))
+ ;;(add-keywords-hook (mumamo-font-lock-keyword-hook-symbol major))
+ byte-compiled-fun
+ (fetch-func-definition `(lambda (body))) ;;`(defun ,func-sym (body)))
+ temp-buf-name
+ temp-buf)
+ ;; font-lock-mode can't be turned on in buffers whose names start
+ ;; with a char with white space syntax. Temp buffer names are
+ ;; such and it is not possible to change name of a temp buffer.
+ (setq temp-buf-name (concat "mumamo-fetch-major-mode-setup-" (symbol-name major)))
+ (setq temp-buf (get-buffer temp-buf-name))
+ (when temp-buf (kill-buffer temp-buf))
+ (setq temp-buf (get-buffer-create temp-buf-name))
+ ;;(msgtrc "fetch-major-mode-setup in buffer %s, after-chunk=%s, before with-current-buffer" (current-buffer) (when (boundp 'after-chunk) after-chunk))
+ (with-current-buffer temp-buf
+
+ (mumamo-msgfntfy "mumamo-fetch-major-mode-setup %s" major)
+ (let ((mumamo-fetching-major t)
+ mumamo-multi-major-mode)
+ ;;(msgtrc "fetch-major-mode-setup in buffer %s, before (funcall %s)" (current-buffer) major)
+ (funcall major)
+ )
+
+ (mumamo-msgfntfy ">>> mumamo-fetch-major-mode-setup A font-lock-mode=%s" font-lock-mode)
+ (font-lock-mode 1)
+ (mumamo-msgfntfy "<<< mumamo-fetch-major-mode-setup B font-lock-mode=%s" font-lock-mode)
+ (mumamo-msgfntfy "mumamo-fetch-major-mode-setup: fetching jit-lock-after-change-extend-region-functions A=%s" jit-lock-after-change-extend-region-functions)
+
+ ;; Note: font-lock-set-defaults must be called before adding
+ ;; keywords. Otherwise Emacs loops. I have no idea why. Hm,
+ ;; probably wrong, it is likely to be nxhtml-mumamo that is the
+ ;; problem. Does not loop in html-mumamo.
+ ;;(msgtrc "\n--------------------")
+ (font-lock-set-defaults)
+ ;; Fix-me: but hi-lock still does not work... what have I
+ ;; forgotten??? font-lock-keywords looks ok...
+ (when keywords
+ (if add-keywords
+ (progn
+ ;;(msgtrc "fetch:font-lock-add-keywords %S %S %S" (if mode-keywords major nil) keywords how)
+ (font-lock-add-keywords (if mode-keywords major nil) keywords how)
+ ;;(font-lock-add-keywords major keywords how)
+ ;;(msgtrc "fetch:font-lock-keywords=%S" font-lock-keywords)
+ )
+ (font-lock-remove-keywords (if mode-keywords major nil) keywords)
+ ;;(font-lock-remove-keywords major keywords)
+ )
+ (unless mode-keywords (font-lock-mode -1) (font-lock-mode 1))
+ ;;(msgtrc "fetch-major-mode-setup:font-lock-keywords=%S" font-lock-keywords)
+ )
+ ;;(run-hooks add-keywords-hook)
+
+ (add-to-list 'mumamo-major-modes-local-maps
+ (let ((local-map (current-local-map)))
+ (cons major-mode (if local-map
+ (copy-keymap local-map)
+ 'no-local-map))))
+
+ (mumamo-msgfntfy "mumamo-fetch-major-mode-setup: fetching jit-lock-after-change-extend-region-functions B=%s" jit-lock-after-change-extend-region-functions)
+ (let* ((syntax-sym (intern-soft (concat (symbol-name major) "-syntax-table")))
+ (fetch-func-definition-let
+ ;; Be XML compliant:
+ (list
+ (list 'sgml-xml-mode
+ ;;(when (mumamo-derived-from-mode ',major 'sgml-mode) t))
+ (when (mumamo-derived-from-mode major 'sgml-mode) t))
+
+ ;; We need to copy the variables that we need and
+ ;; that are not automatically buffer local, but
+ ;; could be it. Arguably it is a bug if they are not
+ ;; buffer local though we have to adapt.
+
+ ;; From cc-mode.el:
+ (list 'indent-line-function (custom-quote indent-line-function))
+ (list 'indent-region-function (custom-quote indent-region-function))
+ (list 'normal-auto-fill-function (custom-quote normal-auto-fill-function))
+ (list 'comment-start (custom-quote comment-start))
+ (list 'comment-end (custom-quote comment-end))
+ (list 'comment-start-skip (custom-quote comment-start-skip))
+ (list 'comment-end-skip (custom-quote comment-end-skip))
+ (list 'comment-multi-line (custom-quote comment-multi-line))
+ (list 'comment-line-break-function (custom-quote comment-line-break-function))
+ (list 'paragraph-start (custom-quote paragraph-start))
+ (list 'paragraph-separate (custom-quote paragraph-separate))
+ (list 'paragraph-ignore-fill-prefix (custom-quote paragraph-ignore-fill-prefix))
+ (list 'adaptive-fill-mode (custom-quote adaptive-fill-mode))
+ (list 'adaptive-fill-regexp (custom-quote adaptive-fill-regexp))
+
+ ;;; Try doing the font lock things last, keywords really last
+ (list 'font-lock-multiline (custom-quote font-lock-multiline))
+ (list 'font-lock-extend-after-change-region-function (custom-quote font-lock-extend-after-change-region-function))
+ (list 'font-lock-extend-region-functions (custom-quote font-lock-extend-region-functions))
+ (list 'font-lock-comment-start-skip (custom-quote font-lock-comment-start-skip))
+ (list 'font-lock-comment-end-skip (custom-quote font-lock-comment-end-skip))
+ (list 'font-lock-syntactic-keywords (custom-quote font-lock-syntactic-keywords))
+
+ (list 'font-lock-keywords (custom-quote font-lock-keywords))
+ ;;(list 'font-lock-keywords-alist (custom-quote font-lock-keywords-alist))
+ ;;(list 'font-lock-removed-keywords-alist (custom-quote font-lock-removed-keywords-alist))
+
+ ;; Fix-me: uncommenting this line (as it should be)
+ ;; sets font-lock-keywords-only to t globally...: bug 3467
+ (list 'font-lock-keywords-only (custom-quote font-lock-keywords-only))
+
+ (list 'font-lock-keywords-case-fold-search (custom-quote font-lock-keywords-case-fold-search))
+
+ (list 'font-lock-set-defaults t) ; whether we have set up defaults.
+
+ ;; Set from font-lock-defaults normally:
+ (list 'font-lock-defaults (custom-quote (copy-tree font-lock-defaults)))
+ ;; Syntactic Font Lock
+ (list 'font-lock-syntax-table (custom-quote font-lock-syntax-table)) ;; See nXhtml bug 400415
+ (list 'font-lock-beginning-of-syntax-function (custom-quote font-lock-beginning-of-syntax-function))
+ (list 'font-lock-syntactic-face-function (custom-quote font-lock-syntactic-face-function))
+
+ ;; Other Font Lock Variables
+ (list 'font-lock-mark-block-function (custom-quote font-lock-mark-block-function))
+ (list 'font-lock-extra-managed-props (custom-quote font-lock-extra-managed-props))
+ ;; This value is fetched from font-lock:
+ (list 'font-lock-fontify-buffer-function (custom-quote font-lock-fontify-buffer-function))
+ (list 'font-lock-unfontify-buffer-function (custom-quote font-lock-unfontify-buffer-function))
+ (list 'font-lock-fontify-region-function (custom-quote font-lock-fontify-region-function))
+ (list 'font-lock-unfontify-region-function (custom-quote font-lock-unfontify-region-function))
+
+ ;; Jit Lock Variables
+ (list 'jit-lock-after-change-extend-region-functions (custom-quote jit-lock-after-change-extend-region-functions))
+
+ ;;(list 'syntax-table (custom-quote (copy-syntax-table (syntax-table))))
+ ;;(list 'mumamo-original-syntax-begin-function (custom-quote syntax-begin-function))
+ (list 'syntax-begin-function (custom-quote syntax-begin-function))
+ (list 'fill-paragraph-function (custom-quote fill-paragraph-function))
+ (list 'fill-forward-paragraph-function
+ (when (boundp 'fill-forward-paragraph-function)
+ (custom-quote fill-forward-paragraph-function)))
+
+ ;; newcomment
+ (list 'comment-use-global-state (custom-quote (when (boundp 'comment-use-global-state) comment-use-global-state)))
+
+ ;; parsing sexps
+ (list 'multibyte-syntax-as-symbol (custom-quote multibyte-syntax-as-symbol))
+ (list 'parse-sexp-ignore-comments (custom-quote parse-sexp-ignore-comments))
+ (list 'parse-sexp-lookup-properties (custom-quote parse-sexp-lookup-properties))
+ ;; fix-me: does not the next line work?
+ (list 'forward-sexp-function (custom-quote forward-sexp-function))
+ ))
+ (relevant-buffer-locals (mumamo-get-relevant-buffer-local-vars))
+ )
+ ;;(append '(1 2) '(3 4) '((eval body)))
+ (mumamo-msgfntfy "===========> before setq fetch-func-definition %s" func-sym)
+ ;; Avoid doublets
+ (dolist (fetched fetch-func-definition-let)
+ (let ((fvar (car fetched)))
+ (setq relevant-buffer-locals (assq-delete-all fvar relevant-buffer-locals))))
+ (setq fetch-func-definition
+ (append fetch-func-definition
+ `((let ,(append fetch-func-definition-let
+ relevant-buffer-locals)
+ (with-syntax-table ,(if syntax-sym
+ syntax-sym
+ '(standard-syntax-table));;'syntax-table
+ ;; fix-me: Protect against font-lock-keywords-only to t globally...: bug 3467
+ ;;(msgtrc "%s enter 1: font-lock-keywords-only def=%s, body=%S" ',major (default-value 'font-lock-keywords-only) body)
+ (let (;(font-lock-keywords-only font-lock-keywords-only)
+ ret)
+ ;;(msgtrc "%s enter 2: font-lock-keywords-only def=%s" ',major (default-value 'font-lock-keywords-only))
+ (setq ret (eval body))
+ ;;(msgtrc "%s exit 1: font-lock-keywords-only def=%s" ',major (default-value 'font-lock-keywords-only))
+ ret))
+ ;;(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))
+ )
+ ;;(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))
+ ;;(message "backtrace there:\n%s" (with-output-to-string (backtrace)))
+ )))
+
+ (setq byte-compiled-fun (let ((major-syntax-table))
+ (byte-compile fetch-func-definition)))
+ (assert (functionp byte-compiled-fun))
+ (unless keywords
+ (eval `(defvar ,func-sym nil))
+ (eval `(defvar ,func-def-sym ,fetch-func-definition))
+ (set func-sym byte-compiled-fun) ;; Will be used as default
+ (assert (functionp (symbol-value func-sym)) t)
+ (funcall (symbol-value func-sym) nil)
+ (put func-sym 'permanent-local t)
+ (put func-def-sym 'permanent-local t))))
+ (kill-buffer temp-buf)
+ ;; Use the new value in current buffer.
+ (when keywords
+ ;;(set (make-local-variable func-sym) (symbol-value func-sym))
+ ;;(msgtrc "fetch: major=%s func-def-sym=%s cb=%s fetch-func-definition=%s" major func-def-sym (current-buffer) fetch-func-definition)
+ ;;(msgtrc "fetch: major=%s func-def-sym=%s cb=%s fetch-func-definition" major func-def-sym (current-buffer))
+ (set (make-local-variable func-sym) byte-compiled-fun)
+ (set (make-local-variable func-def-sym) fetch-func-definition)
+ (put func-sym 'permanent-local t)
+ (put func-def-sym 'permanent-local t))
+ (assert (functionp (symbol-value func-sym)) t)
+ ;; return a list def + fun
+ (cons func-sym func-def-sym)))
+
+;; Fix-me: maybe a hook in font-lock-add-keywords??
+(defun mumamo-ad-font-lock-keywords-helper (major keywords how add-keywords)
+ ;;(msgtrc "ad-font-lock-keywords-helper %s %s %s %s" major keywords how add-keywords)
+ (if major
+ (mumamo-fetch-major-mode-setup major keywords t t how)
+ ;; Fix-me: Can't do that, need a list of all
+ ;; mumamo-current-chunk-family chunk functions major
+ ;; modes. But this is impossible since the major modes might
+ ;; be determined dynamically. As a work around look in current
+ ;; chunks.
+ (let ((majors (list (mumamo-main-major-mode))))
+ (dolist (entry mumamo-internal-major-modes-alist)
+ (let ((major (car entry))
+ (fun-var-sym (caadr entry)))
+ (when (local-variable-p fun-var-sym)
+ (setq majors (cons (car entry) majors)))))
+ (dolist (major majors)
+ (setq major (mumamo-get-major-mode-substitute major 'fontification))
+ ;;(msgtrc "(fetch-major-mode-setup %s %s %s %s %s)" major keywords nil t how)
+ (mumamo-fetch-major-mode-setup major keywords nil add-keywords how))
+ ;;(font-lock-mode -1) (font-lock-mode 1)
+ )))
+
+;; Fix-me: This has stopped working again 2009-11-04, but I do not know when it began...
+(defadvice font-lock-add-keywords (around
+ mumamo-ad-font-lock-add-keywords
+ activate
+ compile)
+ (if (or (boundp 'mumamo-fetching-major) (boundp 'mumamo-add-font-lock-called) (not mumamo-multi-major-mode))
+ ad-do-it
+ (let (mumamo-multi-major-mode
+ mumamo-add-font-lock-called
+ (major (ad-get-arg 0))
+ (keywords (ad-get-arg 1))
+ (how (ad-get-arg 2)))
+ (mumamo-ad-font-lock-keywords-helper major keywords how t))))
+
+(defadvice font-lock-remove-keywords (around
+ mumamo-ad-font-lock-remove-keywords
+ activate
+ compile)
+ (if (or (boundp 'mumamo-fetching-major) (boundp 'mumamo-add-font-lock-called) (not mumamo-multi-major-mode))
+ ad-do-it
+ (let (mumamo-multi-major-mode
+ mumamo-add-font-lock-called
+ (major (ad-get-arg 0))
+ (keywords (ad-get-arg 1)))
+ (mumamo-ad-font-lock-keywords-helper major keywords nil nil))))
+
+(defun mumamo-bad-mode ()
+ "MuMaMo replacement for a major mode that could not be loaded."
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode 'mumamo-bad-mode)
+ (setq mode-name
+ (propertize "Mumamo Bad Mode"
+ 'face 'font-lock-warning-face)))
+
+;;(mumamo-get-major-mode-setup 'css-mode)
+;;(mumamo-get-major-mode-setup 'fundamental-mode)
+(defun mumamo-get-major-mode-setup (use-major)
+ "Return function for evaluating code in major mode USE-MAJOR.
+Fix-me: This doc string is wrong, old:
+
+Get local variable values for major mode USE-MAJOR. These
+variables are used for indentation and fontification. The
+variables are returned in a list with the same format as
+`mumamo-fetch-major-mode-setup'.
+
+The list of local variable values which is returned by this
+function is cached in `mumamo-internal-major-modes-alist'. This
+avoids calling the major mode USE-MAJOR for each chunk during
+fontification and speeds up fontification significantly."
+ ;; Fix-me: Problems here can cause mumamo to loop badly when this
+ ;; function is called over and over again. To avoid this add a
+ ;; temporary entry using mumamo-bad-mode while trying to fetch the
+ ;; correct mode.
+
+ ;;(assq 'mumamo-bad-mode mumamo-internal-major-modes-alist)
+ (let ((use-major-entry (assq use-major mumamo-internal-major-modes-alist))
+ bad-mode-entry
+ dummy-entry
+ fun-var-sym
+ fun-var-def-sym)
+ (unless use-major-entry
+ ;; Get mumamo-bad-mode entry and add a dummy entry based on
+ ;; this to avoid looping.
+ (setq bad-mode-entry
+ (assq 'mumamo-bad-mode mumamo-internal-major-modes-alist))
+ (unless bad-mode-entry
+ ;; Assume it is safe to get the mumamo-bad-mode entry ;-)
+ (add-to-list 'mumamo-internal-major-modes-alist
+ (list 'mumamo-bad-mode
+ (mumamo-fetch-major-mode-setup 'mumamo-bad-mode nil nil nil nil)))
+ (setq bad-mode-entry
+ (assq 'mumamo-bad-mode mumamo-internal-major-modes-alist)))
+ (setq dummy-entry (list use-major (cadr bad-mode-entry)))
+ ;; Before fetching setup add the dummy entry and then
+ ;; immediately remove it.
+ (add-to-list 'mumamo-internal-major-modes-alist dummy-entry)
+ (setq use-major-entry (list use-major
+ (mumamo-fetch-major-mode-setup use-major nil nil nil nil)))
+ (setq mumamo-internal-major-modes-alist
+ (delete dummy-entry
+ mumamo-internal-major-modes-alist))
+ (add-to-list 'mumamo-internal-major-modes-alist use-major-entry))
+ (setq fun-var-sym (caadr use-major-entry))
+ (setq fun-var-def-sym (cdadr use-major-entry))
+ (assert (functionp (symbol-value fun-var-sym)) t)
+ (assert (eq 'lambda (car (symbol-value fun-var-def-sym))) t)
+ ;; Always make a buffer local value for keywords.
+ (unless (local-variable-p fun-var-sym)
+ (set (make-local-variable fun-var-sym) (symbol-value fun-var-sym))
+ (set (make-local-variable fun-var-def-sym) (symbol-value fun-var-def-sym)))
+ (caadr (or (assq use-major mumamo-internal-major-modes-alist)
+ ))))
+;; (assq use-major
+;; (add-to-list 'mumamo-internal-major-modes-alist
+;; (list use-major
+;; (mumamo-fetch-major-mode-setup
+;; use-major nil nil nil))))))))
+
+(defun mumamo-remove-all-chunk-overlays ()
+ "Remove all CHUNK overlays from the current buffer."
+ (save-restriction
+ (widen)
+ (mumamo-delete-new-chunks)))
+
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Creating and accessing chunks
+
+(defun mumamo-define-no-mode (mode-sym)
+ "Fallback major mode when no major mode for MODE-SYM is found."
+ (let ((mumamo-repl4 (intern (format "mumamo-4-%s" mode-sym)))
+ (lighter (format "No %s" mode-sym))
+ (doc (format "MuMaMo replacement for %s which was not found."
+ mode-sym)))
+ (if (commandp mumamo-repl4)
+ mumamo-repl4
+ (eval `(defun ,mumamo-repl4 ()
+ ,doc
+ (interactive)
+ (kill-all-local-variables)
+ (setq major-mode ',mumamo-repl4)
+ (setq mode-name
+ (propertize ,lighter
+ 'face 'font-lock-warning-face)))))))
+;;(mumamo-define-no-mode 'my-ownB-mode)
+
+;;(mumamo-major-mode-from-modespec 'javascript-mode)
+(defun mumamo-major-mode-from-modespec (major-spec)
+ "Translate MAJOR-SPEC to a major mode.
+Translate MAJOR-SPEC used in chunk definitions of multi major
+modes to a major mode.
+
+See `mumamo-major-modes' for an explanation."
+ (mumamo-major-mode-from-spec major-spec mumamo-major-modes))
+
+(defun mumamo-major-mode-from-spec (major-spec table)
+ (unless major-spec
+ (mumamo-backtrace "mode-from-modespec, major-spec is nil"))
+ (let ((modes (cdr (assq major-spec table)))
+ (mode 'mumamo-bad-mode))
+ (setq mode
+ (catch 'mode
+ (dolist (m modes)
+ (when (functionp m)
+ (let ((def (symbol-function m)))
+ (when (and (listp def)
+ (eq 'autoload (car def)))
+ (mumamo-condition-case err
+ (load (nth 1 def))
+ (error (setq m nil)))))
+ (when m (throw 'mode m))))
+ nil))
+ (unless mode
+ (if (functionp major-spec)
+ ;; As a last resort allow spec to be a major mode too:
+ (setq mode major-spec)
+ (if modes
+ (mumamo-warn-once '(mumamo-major-mode-from-modespec)
+ "Couldn't find an available major mode for specification %s,\n alternatives are:\n %s"
+ major-spec modes)
+ (mumamo-warn-once '(mumamo-major-mode-from-modespec)
+ "Couldn't find an available major mode for spec %s"
+ major-spec))
+ ;;(setq mode 'fundamental-mode)
+ (setq mode (mumamo-define-no-mode major-spec))
+ ))
+ (mumamo-msgfntfy " mumamo-major-mode-from-modespec %s => %s" major-spec mode)
+ mode))
+
+(defun mumamo-get-existing-new-chunk-at (pos &optional first)
+ "Return last existing chunk at POS if any.
+However if FIRST get first existing chunk at POS instead."
+ ;;(msgtrc "(mumamo-get-existing-new-chunk-at %s)" pos)
+ (let ((chunk-ovl)
+ (orig-pos pos))
+ (when (= pos (point-max))
+ (setq pos (1- pos)))
+ (when (= pos 0) (setq pos 1))
+ (dolist (o (overlays-in pos (1+ pos)))
+ (when (and (overlay-get o 'mumamo-is-new)
+ ;; Because overlays-in need to have a range of length
+ ;; > 0 we might have got overlays that is after our
+ ;; orig-pos:
+ (<= (overlay-start o) orig-pos))
+ ;; There can be two, choose the last or first depending on
+ ;; FIRST.
+ (if chunk-ovl
+ ;; (when (or (> (overlay-end o) (overlay-start o))
+ ;; (overlay-get o 'mumamo-prev-chunk))
+ (when (if first
+ (< (overlay-end o) (overlay-end chunk-ovl))
+ (> (overlay-end o) (overlay-end chunk-ovl))
+ )
+ (setq chunk-ovl o))
+ (setq chunk-ovl o))))
+ chunk-ovl))
+
+(defun mumamo-get-chunk-save-buffer-state (pos)
+ "Return chunk overlay at POS. Preserve state."
+ (let (chunk)
+ ;;(mumamo-save-buffer-state nil
+ ;;(setq chunk (mumamo-get-chunk-at pos)))
+ (setq chunk (mumamo-find-chunks pos "mumamo-get-chunk-save-buffer-state"))
+ ;;)
+ chunk))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Chunk and chunk family properties
+
+(defun mumamo-syntax-maybe-completable (pnt)
+ "Return non-nil if at point PNT non-printable characters may occur.
+This just considers existing chunks."
+ (let* ((chunk (mumamo-find-chunks pnt "mumamo-syntax-maybe-completable"))
+ syn-min-max)
+ (if (not chunk)
+ t
+ (mumamo-update-obscure chunk pnt)
+ (setq syn-min-max (mumamo-chunk-syntax-min-max chunk nil))
+ ;;(and (> pnt (1+ (mumamo-chunk-syntax-min chunk)))
+ (and (> pnt (1+ (car syn-min-max)))
+ ;;(< pnt (1- (mumamo-chunk-syntax-max chunk)))))))
+ (< pnt (1- (cdr syn-min-max)))))))
+
+(defvar mumamo-current-chunk-family nil
+ "The currently used chunk family.")
+(make-variable-buffer-local 'mumamo-current-chunk-family)
+(put 'mumamo-current-chunk-family 'permanent-local t)
+
+;; (defvar mumamo-main-major-mode nil)
+;; (make-variable-buffer-local 'mumamo-main-major-mode)
+;; (put 'mumamo-main-major-mode 'permanent-local t)
+
+(defun mumamo-main-major-mode ()
+ "Return major mode used when there are no chunks."
+ (let ((mm (cadr mumamo-current-chunk-family)))
+ (if mm mm
+ (msgtrc "main-major-mode => nil, mumamo-current-chunk-family=%s" mumamo-current-chunk-family))))
+;;; (let ((main (cadr mumamo-current-chunk-family)))
+;;; (if main
+;;; main
+;;; mumamo-main-major-mode)))
+
+;; (defun mumamo-unset-chunk-family ()
+;; "Set chunk family to nil, ie undecided."
+;; (interactive)
+;; (setq mumamo-current-chunk-family nil))
+
+;; (defun mumamo-define-chunks (chunk-family)
+;; "Set the CHUNK-FAMILY used to divide the buffer."
+;; (setq mumamo-current-chunk-family chunk-family))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; General chunk search routines
+
+;; search start forward
+
+;;(defun mumamo-search-fw-exc-start-str (pos max marker)
+(defun mumamo-chunk-start-fw-str (pos max marker)
+ "General chunk function helper.
+A chunk function helper like this can be used in
+`mumamo-find-possible-chunk' to find the borders of a chunk.
+There are several functions like this that comes with mumamo.
+Their names tell what they do. Lets look at the parts of the
+name of this function:
+
+ mumamo-chunk: All this helper functions begins so
+ -start-: Search for the start of a chunk
+ -fw-: Search forward
+ -str: Search for a string
+
+Instead of '-start-' there could be '-end-', ie end.
+Instead of '-fw-' there could be '-bw-', ie backward.
+Instead of '-str' there could be '-re', ie regular expression.
+
+There could also be a '-inc' at the end of the name. If the name
+ends with this then the markers should be included in the chunks,
+otherwise not.
+
+The argument POS means where to start the search. MAX means how
+far to search (when searching backwards the argument is called
+'min' instead). MARKER is a string or regular expression (see
+the name) to search for."
+ (assert (stringp marker))
+ (let ((pm (point-min))
+ (cb (current-buffer)))
+ (message "cb=%s" cb)
+ (goto-char (max pm (- pos (length marker)))))
+ (search-forward marker max t))
+
+(defun mumamo-chunk-start-fw-re (pos max marker)
+ "General chunk function helper.
+See `mumamo-chunk-start-fw-str' for more information and the
+meaning of POS, MAX and MARKER."
+ (assert (stringp marker))
+ (goto-char (- pos (length marker)))
+ (re-search-forward marker max t))
+
+(defun mumamo-chunk-start-fw-str-inc (pos max marker)
+ "General chunk function helper.
+See `mumamo-chunk-start-fw-str' for more information and the
+meaning of POS, MAX and MARKER."
+ (assert (stringp marker))
+ (goto-char pos)
+ (let ((start (search-forward marker max t)))
+ (when start (setq start (- start (length marker))))))
+
+;; search start backward
+
+;; (defun mumamo-chunk-start-bw-str (pos min marker)
+;; "General chunk function helper.
+;; See `mumamo-chunk-start-fw-str' for more information and the
+;; meaning of POS, MIN and MARKER."
+;; ;;(assert (stringp marker))
+;; (let (start-in)
+;; (goto-char pos)
+;; (setq start-in (search-backward marker min t))
+;; (when start-in
+;; ;; do not include the marker
+;; (setq start-in (+ start-in (length marker))))
+;; start-in))
+
+;; (defun mumamo-chunk-start-bw-re (pos min marker)
+;; "General chunk function helper.
+;; See `mumamo-chunk-start-fw-str' for more information and the
+;; meaning of POS, MIN and MARKER."
+;; (assert (stringp marker))
+;; (let (start-in)
+;; (goto-char pos)
+;; (setq start-in (re-search-backward marker min t))
+;; (when start-in
+;; ;; do not include the marker
+;; (setq start-in (match-end 0)))
+;; start-in))
+
+;; (defun mumamo-chunk-start-bw-str-inc (pos min marker)
+;; "General chunk function helper.
+;; See `mumamo-chunk-start-fw-str' for more information and the
+;; meaning of POS, MIN and MARKER."
+;; (assert (stringp marker))
+;; (goto-char (+ pos (length marker)))
+;; (search-backward marker min t))
+
+;; search end forward
+
+(defun mumamo-chunk-end-fw-str (pos max marker)
+ "General chunk function helper.
+See `mumamo-chunk-start-fw-str' for more information and the
+meaning of POS, MAX and MARKER."
+ (assert (stringp marker))
+ ;;(goto-char (1+ pos)) ;; 1+ cause otherwise ?> is at point
+ (goto-char pos)
+ (let (end-in)
+ (setq end-in (search-forward marker max t))
+ (when end-in
+ ;; do not include the marker
+ (setq end-in (- end-in (length marker))))
+ end-in))
+
+(defun mumamo-chunk-end-fw-re (pos max marker)
+ "General chunk function helper.
+See `mumamo-chunk-start-fw-str' for more information and the
+meaning of POS, MAX and MARKER."
+ (assert (stringp marker))
+ (goto-char (1+ pos)) ;; 1+ cause otherwise ?> is at point
+ (let (end-in)
+ (setq end-in (re-search-forward marker max t))
+ (when end-in
+ ;; do not include the marker
+ (setq end-in (match-beginning 0)))
+ end-in))
+
+(defun mumamo-chunk-end-fw-str-inc (pos max marker)
+ "General chunk function helper.
+See `mumamo-chunk-start-fw-str' for more information and the
+meaning of POS, MAX and MARKER."
+ (assert (stringp marker))
+ ;;(goto-char (1+ pos)) ;; 1+ cause otherwise ?> is at point
+ (goto-char (1+ (- pos (length marker))))
+ ;;(msgtrc "mumamo-chunk-end-fw-str-inc %s %s %s, point=%s point-max=%s" pos max marker (point) (point-max))
+ (search-forward marker max t))
+
+;; search end backward
+
+;; (defun mumamo-chunk-end-bw-str (pos min marker)
+;; "General chunk function helper.
+;; See `mumamo-chunk-start-fw-str' for more information and the
+;; meaning of POS, MIN and MARKER."
+;; (assert (stringp marker))
+;; (goto-char (+ pos (length marker)))
+;; (search-backward marker min t))
+
+;; (defun mumamo-chunk-end-bw-re (pos min marker)
+;; "General chunk function helper.
+;; See `mumamo-chunk-start-fw-str' for more information and the
+;; meaning of POS, MIN and MARKER."
+;; (assert (stringp marker))
+;; (goto-char (+ pos (length marker)))
+;; (re-search-backward marker min t))
+
+(defun mumamo-chunk-end-bw-str-inc (pos min marker)
+ "General chunk function helper.
+See `mumamo-chunk-start-fw-str' for more information and the
+meaning of POS, MIN and MARKER."
+ (assert (stringp marker))
+ (goto-char pos)
+ (let ((end (search-backward marker min t)))
+ (when end (setq end (+ end (length marker))))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; General chunk routines
+
+;; (defvar mumamo-known-chunk-start nil "Internal use only!.")
+
+(defconst mumamo-string-syntax-table
+ (let ((tbl (copy-syntax-table)))
+ (modify-syntax-entry ?\" "\"" tbl)
+ (modify-syntax-entry ?\' "\"" tbl)
+ tbl)
+ "Just for \"..\" and '...'.")
+
+;; "..." '...' "..'.." '.."..'
+(defun mumamo-guess-in-string (pos)
+ "If POS is in a string then return string start position.
+Otherwise return nil."
+ (when (and (>= pos (point-min)))
+ (let ((here (point))
+ (inhibit-field-text-motion t)
+ line-beg
+ parsed
+ str-char
+ str-pos)
+ (goto-char pos)
+ (setq line-beg (line-beginning-position))
+ (setq parsed (with-syntax-table mumamo-string-syntax-table
+ (parse-partial-sexp line-beg pos)))
+ (setq str-char (nth 3 parsed))
+ (when str-char
+ (skip-chars-backward (string ?^ str-char))
+ (setq str-pos (point)))
+ (goto-char here)
+ str-pos)))
+
+;;; The main generic chunk routine
+
+;; Fix-me: new routine that really search forward only. Rewrite
+;; `mumamo-quick-static-chunk' first with this.
+(defun mumamo-possible-chunk-forward (pos
+ max
+ chunk-start-fun
+ chunk-end-fun
+ &optional borders-fun)
+ "Search forward from POS to MAX for possible chunk.
+Return as a list with values
+
+ \(START END CHUNK-MAJOR BORDERS PARSEABLE-BY CHUNK-END-FUN BORDERS-FUN)
+
+START and END are start and end of the possible chunk.
+CHUNK-MAJOR is the major mode specifier for this chunk. \(Note
+that this specifier is translated to a major mode through
+`mumamo-major-modes'.)
+
+START-BORDER and END-BORDER may be nil. Otherwise they should be
+the position where the border ends respectively start at the
+corresponding end of the chunk.
+
+BORDERS is the return value of the optional BORDERS-FUN which
+takes three parameters, START, END and EXCEPTION-MODE in the
+return values above. BORDERS may be nil and otherwise has this
+format:
+
+ \(START-BORDER END-BORDER CHUNK-MAJOR CHUNK-END-FUN)
+
+PARSEABLE-BY is a list of major modes with parsers that can parse
+the chunk.
+
+CHUNK-START-FUN and CHUNK-END-FUN should be functions that
+searches forward from point for start and end of chunk. They
+both take two parameters, POS and MAX above. If no possible
+chunk is found both these functions should return nil, otherwise
+see below.
+
+CHUNK-START-FUN should return a list of the form below if a
+possible chunk is found:
+
+ (START CHUNK-MAJOR PARSEABLE-BY)
+
+CHUNK-END-FUN should return the end of the chunk.
+
+"
+ ;;(msgtrc "possible-chunk-forward %s %s" pos max)
+ (let ((here (point))
+ start-rec
+ start
+ end
+ chunk-major
+ parseable-by
+ borders
+ ret
+ )
+ (goto-char pos)
+ ;; Fix-me: check valid. Should this perhaps be done in the
+ ;; function calling this instead?
+ ;;(mumamo-end-in-code syntax-min syntax-max curr-major)
+ (setq start-rec (funcall chunk-start-fun (point) max))
+ (when start-rec
+ (setq start (nth 0 start-rec))
+ (setq chunk-major (nth 1 start-rec))
+ (setq parseable-by (nth 2 start-rec))
+ (goto-char start)
+ ;; Fix-me: check valid
+ ;;(setq end (funcall chunk-end-fun (point) max))
+ (when borders-fun
+ (let ((start-border (when start (unless (and (= 1 start)
+ (not chunk-major))
+ start)))
+ (end-border (when end (unless (and (= (point-max) end)
+ (not chunk-major))
+ end))))
+ (setq borders (funcall borders-fun start-border end-border chunk-major))))
+ (setq ret (list start end chunk-major borders parseable-by chunk-end-fun borders-fun)))
+ (goto-char here)
+ ret))
+
+;; Fix-me: This routine has some difficulties. One of the more
+;; problematic things is that chunk borders may depend on the
+;; surrounding chunks syntax. Patterns that possibly could be chunk
+;; borders might instead be parts of comments or strings in cases
+;; where they should not be valid borders there.
+(defun mumamo-find-possible-chunk (pos
+ min max
+ bw-exc-start-fun ;; obsolete
+ bw-exc-end-fun
+ fw-exc-start-fun
+ fw-exc-end-fun
+ &optional find-borders-fun)
+ (mumamo-find-possible-chunk-new pos
+ ;;min
+ max
+ bw-exc-start-fun
+ ;;bw-exc-end-fun
+ fw-exc-start-fun
+ fw-exc-end-fun
+ find-borders-fun))
+
+(defun mumamo-find-possible-chunk-new (pos
+ ;;min
+ max
+ bw-exc-start-fun
+ ;;bw-exc-end-fun
+ fw-exc-start-fun
+ fw-exc-end-fun
+ &optional find-borders-fun)
+ ;; This should return no end value!
+ "Return list describing a possible chunk that starts after POS.
+No notice is taken about existing chunks and no chunks are
+created. The description returned is for the smallest possible
+chunk which is delimited by the function parameters.
+
+POS must be less than MAX.
+
+The function BW-EXC-START-FUN takes two parameters, POS and
+MIN. It should search backward from POS, bound by MIN, for
+exception start and return a cons or a list:
+
+ \(FOUND-POS . EXCEPTION-MODE)
+ \(FOUND-POS EXCEPTION-MODE PARSEABLE-BY)
+
+Here FOUND-POS is the start of the chunk. EXCEPTION-MODE is the
+major mode specifier for this chunk. \(Note that this specifier
+is translated to a major mode through `mumamo-major-modes'.)
+
+PARSEABLE-BY is a list of parsers that can handle the chunk
+beside the one that may be used by the chunks major mode.
+Currently only the XML parser in `nxml-mode' is recognized. In
+this list it should be the symbol `nxml-mode'.
+
+The functions FW-EXC-START-FUN and FW-EXC-END-FUN should search
+for exception start or end, forward resp backward. Those two
+takes two parameters, start position POS and max position MAX,
+and should return just the start respectively the end of the
+chunk.
+
+For all three functions the position returned should be nil if
+search fails.
+
+
+Return as a list with values
+
+ \(START END EXCEPTION-MODE BORDERS PARSEABLE-BY FR-EXC-FUN FIND-BORDERS-FUN)
+
+**Fix-me: FIND-BORDERS-FUN must be split for chunks-in-chunks!
+
+The bounds START and END are where the exception starts or stop.
+Either of them may be nil, in which case this is equivalent to
+`point-min' respectively `point-max'.
+
+If EXCEPTION-MODE is non-nil that is the submode for this
+range. Otherwise the main major mode should be used for this
+chunk.
+
+BORDERS is the return value of the optional FIND-BORDERS-FUN
+which takes three parameters, START, END and EXCEPTION-MODE in
+the return values above. BORDERS may be nil and otherwise has
+this format:
+
+ \(START-BORDER END-BORDER EXCEPTION-MODE FW-EXC-FUN)
+
+START-BORDER and END-BORDER may be nil. Otherwise they should be
+the position where the border ends respectively start at the
+corresponding end of the chunk.
+
+PARSEABLE-BY is a list of major modes with parsers that can parse
+the chunk.
+
+FW-EXC-FUN is the function that finds the end of the chunk. This
+is either FW-EXC-START-FUN or FW-EXC-END-FUN.
+
+---- * Note: This routine is used by to create new members for
+chunk families. If you want to add a new chunk family you could
+most often do that by writing functions for this routine. Please
+see the many examples in mumamo-fun.el for how this can be done.
+See also `mumamo-quick-static-chunk'."
+ ;;(msgtrc "====")
+ ;;(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)
+
+ ;;(mumamo-condition-case err
+ (progn
+ (assert (and (<= pos max)) nil
+ "mumamo-chunk: pos=%s, max=%s, bt=%S"
+ pos max (with-output-to-string (backtrace)))
+ ;; "in" refers to "in exception" and "out" is then in main
+ ;; major mode.
+ (let (start-in-cons
+ exc-mode
+ fw-exc-mode
+ fw-exc-fun
+ parseable-by
+ start-in start-out
+ end-in end-out
+ start end
+ ;;end-of-exception
+ wants-end-type
+ found-valid-end
+ (main-major (mumamo-main-major-mode))
+ borders
+ border-beg
+ border-end)
+ ;;;; find start of range
+ ;;
+ ;; start normal
+ ;;
+ ;;(setq start-out (funcall bw-exc-end-fun pos min))
+ ;; Do not check end here!
+ ;;(setq start-out (funcall fw-exc-end-fun pos max))
+ ;;(msgtrc "find-poss-new.start-out=%s" start-out)
+ ;; start exception
+ (setq start-in (funcall fw-exc-start-fun pos max))
+ ;;(msgtrc "find-poss-new.start-in=%s" start-in)
+ (when (listp start-in)
+ (setq fw-exc-mode (nth 1 start-in))
+ (setq start-in (car start-in)))
+ ;; compare
+ (when (and start-in start-out)
+ (if (> start-in start-out)
+ (setq start-in nil)
+ (setq start-out nil)))
+ (cond
+ (start-in
+ (setq start-in-cons (funcall bw-exc-start-fun start-in pos))
+ ;;(msgtrc "find-poss-new.start-in=%s start-in-cons=%s" start-in start-in-cons)
+ (when start-in-cons
+ (assert (= start-in (car start-in-cons)))
+ (setq exc-mode (cdr start-in-cons)))
+ (setq start start-in))
+ (start-out
+ (setq start start-out))
+ )
+ (when (and exc-mode
+ (listp exc-mode))
+ (setq parseable-by (cadr exc-mode))
+ (setq exc-mode (car exc-mode)))
+ ;; borders
+ (when find-borders-fun
+ (let ((start-border (when start (unless (and (= 1 start)
+ (not exc-mode))
+ start)))
+ (end-border (when end (unless (and (= (point-max) end)
+ (not exc-mode))
+ end))))
+ (setq borders (funcall find-borders-fun start-border end-border exc-mode))))
+ ;; check
+ (setq border-beg (nth 0 borders))
+ (setq border-end (nth 1 borders))
+ ;;(when start (assert (<= start pos)))
+ ;;(assert (or (not start) (= start pos)))
+ (when border-beg
+ (assert (<= start border-beg)))
+ ;; Fix-me: This is just totally wrong in some pieces and a
+ ;; desperate try after seeing the problems with wp-app.php
+ ;; around line 1120. Maybe this can be used when cutting chunks
+ ;; from top to bottom however.
+ (when nil ;end
+ (let ((here (point))
+ end-line-beg
+ end-in-string
+ start-in-string
+ (start-border (or (nth 0 borders) start))
+ (end-border (or (nth 1 borders) end)))
+ ;; Check if in string
+ ;; Fix-me: add comments about why and examples + tests
+ ;; Fix-me: must loop to find good borders ....
+ (when end
+ ;; Fix-me: more careful positions for guess
+ (setq end-in-string
+ (mumamo-guess-in-string
+ ;;(+ end 2)
+ (1+ end-border)
+ ))
+ (when end-in-string
+ (when start
+ (setq start-in-string
+ (mumamo-guess-in-string
+ ;;(- start 2)
+ (1- start-border)
+ )))
+ (if (not start-in-string)
+ (setq end nil)
+ (if exc-mode
+ (if (and start-in-string end-in-string)
+ ;; If both are in a string and on the same line then
+ ;; guess this is actually borders, otherwise not.
+ (unless (= start-in-string end-in-string)
+ (setq start nil)
+ (setq end nil))
+ (when start-in-string (setq start nil))
+ (when end-in-string (setq end nil)))
+ ;; Fix-me: ???
+ (when start-in-string (setq start nil))
+ ))
+ (unless (or start end)
+ (setq exc-mode nil)
+ (setq borders nil)
+ (setq parseable-by nil))))))
+
+ (when (or start end exc-mode borders parseable-by)
+ (setq fw-exc-fun (if exc-mode
+ ;; Fix-me: this is currently correct,
+ ;; but will change if exc mode in exc
+ ;; mode is allowed.
+ fw-exc-end-fun
+ ;; Fix-me: these should be collected later
+ ;;fw-exc-start-fun
+ nil
+ ))
+ (mumamo-msgfntfy "--- mumamo-find-possible-chunk-new %s" (list start end exc-mode borders parseable-by fw-exc-fun))
+ ;;(message "--- mumamo-find-possible-chunk-new %s" (list start end exc-mode borders parseable-by fw-exc-fun))
+ (when fw-exc-mode
+ (unless (eq fw-exc-mode exc-mode)
+ ;;(message "fw-exc-mode=%s NEQ exc-mode=%s" fw-exc-mode exc-mode)
+ ))
+ ;;(msgtrc "find-poss-new returns %s" (list start end exc-mode borders parseable-by fw-exc-fun find-borders-fun))
+ (when fw-exc-fun
+ (list start end exc-mode borders parseable-by fw-exc-fun find-borders-fun)))))
+ ;;(error (mumamo-display-error 'mumamo-chunk "%s" (error-message-string err)))
+
+ ;;)
+ )
+
+;; (defun temp-overlays-here ()
+;; (interactive)
+;; (let* ((here (point))
+;; (ovl-at (overlays-at here))
+;; (ovl-in (overlays-in here (1+ here)))
+;; (ovl-in0 (overlays-in here here))
+;; )
+;; (with-output-to-temp-buffer (help-buffer)
+;; (help-setup-xref (list #'temp-overlays-at) (interactive-p))
+;; (with-current-buffer (help-buffer)
+;; (insert (format "overlays-at %s:\n%S\n\n" here ovl-at))
+;; (insert (format "overlays-in %s-%s:\n%S\n\n" here (1+ here) ovl-in))
+;; (insert (format "overlays-in %s-%s:\n%S\n\n" here here ovl-in0))
+;; ))))
+;; (defun temp-cursor-pos ()
+;; (interactive)
+;; (what-cursor-position t))
+;; ;;(global-set-key [f9] 'temp-cursor-pos)
+;; (defun temp-test-new-create-chunk ()
+;; (interactive)
+;; (mumamo-delete-new-chunks)
+;; ;;(setq x1 nil)
+;; (let (x1
+;; (first t))
+;; (while (or first x1)
+;; (setq first nil)
+;; (setq x1 (mumamo-new-create-chunk (mumamo-find-next-chunk-values x1 nil nil nil)))))
+;; )
+
+;; (defun temp-create-last-chunk ()
+;; (interactive)
+;; (mumamo-new-create-chunk (mumamo-find-next-chunk-values mumamo-last-chunk nil nil nil)))
+
+(defun mumamo-delete-new-chunks ()
+ (setq mumamo-last-chunk nil)
+ (save-restriction
+ (widen)
+ (let ((ovls (overlays-in (point-min) (point-max))))
+ (dolist (ovl ovls)
+ (when (overlay-get ovl 'mumamo-is-new)
+ ;;(msgtrc "delete-overlay %s delete-new-chunks" ovl)
+ (delete-overlay ovl))))))
+
+(defun mumamo-new-create-chunk (new-chunk-values)
+ "Create and return a chunk from NEW-CHUNK-VALUES.
+When doing this store the functions for creating the next chunk
+after this in the properties below of the now created chunk:
+
+- 'mumamo-next-major: is nil or the next chunk's major mode.
+- 'mumamo-next-end-fun: function that searches for end of AFTER-CHUNK
+- 'mumamo-next-border-fun: functions that finds borders"
+ ;;((1 696 nxhtml-mode nil nil nil nil) (696 nil php-mode nil nil nil nil))
+ ;;(current (list curr-min curr-max curr-major curr-border-min curr-border-max curr-parseable curr-fw-exc-fun))
+ ;;(msgtrc "######new-create.chunk.new-chunk-values=%s" new-chunk-values)
+ (when new-chunk-values
+ (let* ((this-values (nth 0 new-chunk-values))
+ (next-values (nth 1 new-chunk-values))
+ (next-major (nth 0 next-values))
+ (next-end-fun (nth 1 next-values))
+ (next-border-fun (nth 2 next-values))
+ (next-depth-diff (nth 3 next-values))
+ (next-indent (nth 4 next-values))
+ (this-beg (nth 0 this-values))
+ (this-end (nth 1 this-values))
+ (this-maj (nth 2 this-values))
+ (this-bmin (nth 3 this-values))
+ (this-bmax (nth 4 this-values))
+ (this-pable (nth 5 this-values))
+ (this-after-chunk (nth 7 this-values))
+ ;;(this-is-closed (nth 8 this-values))
+ (this-insertion-type-beg (nth 8 this-values))
+ (this-insertion-type-end (nth 9 this-values))
+ ;;(this-is-closed (and this-end (< 1 this-end)))
+ (this-after-chunk-depth (when this-after-chunk
+ (overlay-get this-after-chunk 'mumamo-depth)))
+ (depth-diff (if this-after-chunk
+ (overlay-get this-after-chunk 'mumamo-next-depth-diff)
+ 1))
+ (depth (if this-after-chunk-depth
+ (+ this-after-chunk-depth depth-diff)
+ 0))
+ ;;(fw-funs (nth 6 this-values))
+ ;;(borders-fun (nth 7 this-values))
+ ;;(this-is-closed (when (or this-end (mumamo-fun-eq this-maj (mumamo-main-major-mode))) t))
+ (use-this-end (if this-end this-end (1+ (buffer-size)))) ;(save-restriction (widen) (point-max))))
+ (this-chunk (when (and (<= this-beg use-this-end)
+ ;; Avoid creating two empty overlays
+ ;; at the this-end - but what if we are
+ ;; not creating, just changing the
+ ;; last overlay ...
+ ;;
+ ;; (not (and (= this-beg use-this-end)
+ ;; (= use-this-end (1+ (buffer-size)))
+ ;; this-after-chunk
+ ;; (= 0 (- (overlay-end this-after-chunk) (overlay-start this-after-chunk)))
+ ;; ))
+ )
+ (when (= this-beg 1)
+ (if (= use-this-end 1)
+ (assert (mumamo-fun-eq (mumamo-main-major-mode) this-maj) t)
+ (if this-after-chunk ;; not first
+ (assert (not (mumamo-fun-eq (mumamo-main-major-mode) this-maj)) t)
+ (assert (mumamo-fun-eq (mumamo-main-major-mode) this-maj) t))))
+ ;;(message "Create chunk %s - %s" this-beg use-this-end)
+ ;;(make-overlay this-beg use-this-end nil nil (not this-is-closed))
+ (make-overlay this-beg use-this-end nil this-insertion-type-beg this-insertion-type-end)
+ ))
+ ;; Fix-me: move to mumamo-find-next-chunk-values
+ (this-border-fun (when (and this-chunk this-after-chunk)
+ ;;(overlay-get this-after-chunk 'mumamo-next-border-fun)
+ (mumamo-chunk-car this-after-chunk 'mumamo-next-border-fun)
+ ))
+ (this-borders (when this-border-fun
+ ;;(msgtrc "(funcall %s %s %s %s)" this-border-fun this-beg this-end this-maj)
+ (funcall this-border-fun this-beg this-end this-maj)))
+ ;; Fix-me, check: there is no first border when moving out.
+ (this-borders-min (when (= 1 depth-diff)
+ (nth 0 this-borders)))
+ ;; Fix-me, check: there is no bottom border when we move
+ ;; further "in" since borders are now always inside
+ ;; sub-chunks (if I remember correctly...).
+ ;;(this-borders-max (when (and this-is-closed
+ (this-borders-max (when (and (not this-insertion-type-end)
+ (/= 1 next-depth-diff))
+ (nth 1 this-borders)))
+ )
+ ;;(msgtrc "created %s, major=%s" this-chunk this-maj)
+ (when (> depth 4) (error "Chunk depth > 4"))
+ (setq this-bmin nil)
+ (setq this-bmax nil)
+ (when this-borders-min (setq this-bmin (- this-borders-min this-beg)))
+ (when this-borders-max (setq this-bmax (- this-end this-borders-max)))
+ ;;(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))
+ ;;(message "fw-funs=%s" fw-funs)
+ (when this-chunk
+ (overlay-put this-chunk 'mumamo-is-new t)
+ (overlay-put this-chunk 'face (mumamo-background-color depth))
+ (overlay-put this-chunk 'mumamo-depth depth)
+ ;; Values for next chunk
+ (overlay-put this-chunk 'mumamo-next-depth-diff next-depth-diff)
+ (assert (symbolp next-major) t)
+ (overlay-put this-chunk 'mumamo-next-major next-major)
+ ;; Values for this chunk
+ ;;(overlay-put this-chunk 'mumamo-is-closed this-is-closed)
+ (overlay-put this-chunk 'mumamo-insertion-type-end this-insertion-type-end)
+ (overlay-put this-chunk 'mumamo-syntax-min-d this-bmin)
+ (overlay-put this-chunk 'mumamo-syntax-max-d this-bmax)
+ (overlay-put this-chunk 'mumamo-prev-chunk this-after-chunk)
+ (overlay-put this-chunk 'mumamo-next-indent next-indent)
+ (when this-after-chunk (overlay-put this-after-chunk 'mumamo-next-chunk this-chunk))
+
+ ;;(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)
+ ;;(overlay-put this-chunk 'mumamo-next-end-fun next-end-fun)
+ (cond
+ ((= 1 next-depth-diff)
+ (mumamo-chunk-push this-chunk 'mumamo-next-border-fun next-border-fun)
+ (mumamo-chunk-push this-chunk 'mumamo-next-end-fun next-end-fun))
+ ((= -1 next-depth-diff)
+ (mumamo-chunk-pop this-chunk 'mumamo-next-border-fun)
+ (mumamo-chunk-pop this-chunk 'mumamo-next-end-fun))
+ ((= 0 next-depth-diff)
+ nil)
+ (t (error "next-depth-diff=%s" next-depth-diff)))
+ ;;(msgtrc "mumamo-next-end-fun=%S" (overlay-get this-chunk 'mumamo-next-end-fun))
+
+ ;; Fix-me: replace 'mumamo-major-mode with multi major mode to make it more flexible.
+ (cond
+ ((= 1 depth-diff)
+ (mumamo-chunk-push this-chunk 'mumamo-major-mode this-maj))
+ ((= -1 depth-diff)
+ (mumamo-chunk-pop this-chunk 'mumamo-major-mode)
+ )
+ (t (error "depth-diff=%s" depth-diff)))
+
+ (overlay-put this-chunk 'mumamo-parseable-by this-pable)
+ (overlay-put this-chunk 'created (current-time-string))
+ (mumamo-update-chunk-margin-display this-chunk)
+ (setq mumamo-last-chunk this-chunk) ;; Use this chunk!!!!
+ ;; Get syntax-begin-function for syntax-ppss:
+ (let* ((syntax-begin-function
+ (mumamo-with-major-mode-fontification this-maj
+ ;; Do like in syntax.el:
+ '(if syntax-begin-function
+ (progn
+ syntax-begin-function)
+ (when (and (not syntax-begin-function)
+ ;; fix-me: How to handle boundp here?
+ (boundp 'font-lock-beginning-of-syntax-function)
+ font-lock-beginning-of-syntax-function)
+ font-lock-beginning-of-syntax-function)))))
+ (mumamo-msgfntfy "Got syntax-begin-function, modified=%s" (buffer-modified-p))
+ (overlay-put this-chunk 'syntax-begin-function syntax-begin-function))
+ )
+ ;;(msgtrc "Created %s, this=%s, next=%s" this-chunk this-values next-values)
+ this-chunk
+ )
+ ))
+
+(defun mumamo-update-chunk-margin-display (chunk)
+ "Set before-string of CHUNK as spec by `mumamo-margin-use'."
+ ;; Fix-me: This is not displayed. Emacs bug?
+ ;;(overlay-put this-chunk 'before-string `((margin left-margin) ,(format "%d %s" depth maj)))
+ (if (not mumamo-margin-info-mode)
+ (overlay-put chunk 'before-string nil)
+ (let* ((depth (overlay-get chunk 'mumamo-depth))
+ (maj (mumamo-chunk-car chunk 'mumamo-major-mode))
+ (strn (propertize (format "%d" depth)
+ 'face (list :inherit (or (mumamo-background-color depth)
+ 'default)
+ :foreground "#505050"
+ :underline t
+ :slant 'normal
+ :weight 'normal
+ )))
+ (maj-name (substring (symbol-name maj) 0 -5))
+ (strm (propertize maj-name 'face
+ (list :foreground "#a0a0a0" :underline nil
+ :background (frame-parameter nil 'background-color)
+ :weight 'normal
+ :slant 'normal)))
+ str
+ (margin (mumamo-margin-used)))
+ (when (> (length strm) 5) (setq strm (substring strm 0 5)))
+ (setq str (concat strn
+ strm
+ (propertize " " 'face 'default)
+ ))
+ (overlay-put chunk 'before-string
+ (propertize " " 'display
+ `((margin ,margin) ,str))))))
+
+(defun mumamo-update-chunks-margin-display (buffer)
+ "Apply `update-chunk-margin-display' to all chunks in BUFFER."
+ (with-current-buffer buffer
+ (save-restriction
+ (widen)
+ (let ((chunk (mumamo-find-chunks 1 "margin-disp"))
+ (while-n0 0))
+ (while (and (mumamo-while 1500 'while-n0 "chunk")
+ chunk)
+ (mumamo-update-chunk-margin-display chunk)
+ (setq chunk (overlay-get chunk 'mumamo-next-chunk)))))))
+
+(defvar mumamo-margin-used nil)
+(make-variable-buffer-local 'mumamo-margin-used)
+(put 'mumamo-margin-used 'permanent-local t)
+
+(defun mumamo-margin-used ()
+ (setq mumamo-margin-used
+ (if (and (boundp 'linum-mode) linum-mode) 'right-margin (nth 0 mumamo-margin-use))))
+
+;; (defun mumamo-set-window-margins-used (win)
+;; "Set window margin according to `mumamo-margin-use'."
+;; ;; Fix-me: old-margin does not work, break it up
+;; (let* ((old-margin-used mumamo-margin-used)
+;; (margin-used (mumamo-margin-used))
+;; (width (nth 1 mumamo-margin-use))
+;; (both-widths (window-margins win))
+;; (old-left (eq old-margin-used 'left-margin))
+;; (left (eq margin 'left-margin)))
+;; ;; Change only the margin we used!
+;; (if (not mumamo-margin-info-mode)
+;; (progn
+;; (set-window-margins win
+;; (if left nil (car both-widths))
+;; (if (not left) nil (cdr both-widths)))
+;; )
+;; ;;(msgtrc "set-window-margins-used margin-info-mode=t")
+;; (case margin-used
+;; ('left-margin (set-window-margins win width (when old-left (cdr both-widths))))
+;; ('right-margin (set-window-margins win (car both-widths) width))))))
+
+(defun mumamo-update-buffer-margin-use (buffer)
+ ;;(msgtrc "update-buffer-margin-use %s" buffer)
+ (when (fboundp 'mumamo-update-chunks-margin-display)
+ (with-current-buffer buffer
+ (when mumamo-multi-major-mode
+ (let* ((old-margin-used mumamo-margin-used)
+ (margin-used (mumamo-margin-used))
+ (old-is-left (eq old-margin-used 'left-margin))
+ (is-left (eq margin-used 'left-margin))
+ (width (nth 1 mumamo-margin-use))
+ (need-update nil))
+ (if (not mumamo-margin-info-mode)
+ (when old-margin-used
+ (setq need-update t)
+ (setq old-margin-used nil)
+ (if old-is-left
+ (setq left-margin-width 0)
+ (setq right-margin-width 0)))
+ (unless (and (eq old-margin-used margin-used)
+ (= width (if old-is-left left-margin-width right-margin-width)))
+ (setq need-update t)
+ (if is-left
+ (setq left-margin-width width)
+ (setq right-margin-width width))
+ (unless (eq old-margin-used margin-used)
+ (if old-is-left
+ (setq left-margin-width 0)
+ (setq right-margin-width 0)))))
+ (when need-update
+ (mumamo-update-chunks-margin-display buffer)
+ (dolist (win (get-buffer-window-list buffer))
+ (set-window-buffer win buffer)))
+ )
+ ;; Note: window update must be before buffer update because it
+ ;; uses old-margin from the call to function margin-used.
+ ;; (dolist (win (get-buffer-window-list buffer))
+ ;; (mumamo-set-window-margins-used win))
+ ;; (mumamo-update-chunks-margin-display buffer)
+ ))))
+
+(defun mumamo-new-chunk-value-min (values)
+ (let ((this-values (nth 0 values)))
+ (nth 0 this-values)))
+
+(defun mumamo-new-chunk-value-max (values)
+ (let ((this-values (nth 0 values)))
+ (nth 1 this-values)))
+
+(defun mumamo-new-chunk-equal-chunk-values (chunk values)
+ ;;(msgtrc "eq? chunk=%S, values=%S" chunk values)
+ (let* (;; Chunk
+ (chunk-is-new (overlay-get chunk 'mumamo-is-new))
+ ;;(chunk-is-closed (overlay-get chunk 'mumamo-is-closed))
+ (chunk-insertion-type-end (overlay-get chunk 'mumamo-insertion-type-end))
+ (chunk-next-major (overlay-get chunk 'mumamo-next-major))
+ (chunk-next-end-fun (mumamo-chunk-car chunk 'mumamo-next-end-fun))
+ (chunk-next-border-fun (mumamo-chunk-car chunk 'mumamo-next-border-fun))
+ (chunk-next-chunk-diff (overlay-get chunk 'mumamo-next-depth-diff))
+ (chunk-beg (overlay-start chunk))
+ (chunk-end (overlay-end chunk))
+ (chunk-bmin (overlay-get chunk 'mumamo-syntax-min-d))
+ (chunk-bmax (overlay-get chunk 'mumamo-syntax-max-d))
+ (chunk-prev-chunk (overlay-get chunk 'mumamo-prev-chunk))
+ (chunk-major-mode (mumamo-chunk-car chunk 'mumamo-major-mode))
+ (chunk-pable (overlay-get chunk 'mumamo-parseable-by))
+ (chunk-depth-diff (if chunk-prev-chunk
+ (overlay-get chunk-prev-chunk 'mumamo-next-depth-diff)
+ 0))
+ ;; Values
+ (this-values (nth 0 values))
+ (next-values (nth 1 values))
+ (values-next-major (nth 0 next-values))
+ (values-next-end-fun (nth 1 next-values))
+ (values-next-border-fun (nth 2 next-values))
+ (values-next-depth-diff (nth 3 next-values))
+ (values-beg (nth 0 this-values))
+ (values-end (nth 1 this-values))
+ (values-major-mode (nth 2 this-values))
+ (values-bmin (nth 3 this-values))
+ (values-bmax (nth 4 this-values))
+ (values-pable (nth 5 this-values))
+ (values-prev-chunk (nth 7 this-values))
+ (values-insertion-type-beg (nth 8 this-values))
+ (values-insertion-type-end (nth 9 this-values))
+ ;;(values-is-closed (when values-end t))
+ )
+ ;;(msgtrc "values=%S" values)
+ (and t ;chunk-is-new
+ (eq chunk-next-major values-next-major)
+
+ ;; Can't check chunk-next-end-fun or chunk-next-border-fun
+ ;; here since they are fetched from prev chunk:
+ ;;(progn (message "eq-c-v: here b: %s /= %s" chunk-next-end-fun values-next-end-fun) t)
+ ;;(eq chunk-next-end-fun values-next-end-fun)
+ ;;(progn (message "eq-c-v: here c, %s /= %s" chunk-next-border-fun values-next-border-fun) t)
+ ;;(eq chunk-next-border-fun values-next-border-fun)
+
+ (= chunk-next-chunk-diff values-next-depth-diff)
+ (= chunk-beg values-beg)
+ ;;(progn (message "eq-c-v: here b") t)
+ ;; (and (equal chunk-is-closed values-is-closed)
+ ;; (or (not chunk-is-closed)
+ (and (equal chunk-insertion-type-end values-insertion-type-end)
+ (or ;;chunk-insertion-type-end
+ (= chunk-end values-end)))
+ ;;(progn (message "eq-c-v: here c, %s /= %s" chunk-major-mode values-major-mode) t)
+ (or (= -1 chunk-depth-diff)
+ (eq chunk-major-mode values-major-mode))
+ ;;(progn (message "eq-c-v: here d") t)
+ (equal chunk-pable values-pable)
+ ;;(progn (message "eq-c-v: here e") t)
+ (eq chunk-prev-chunk values-prev-chunk)
+ ;;(progn (message "eq-c-v: here f") t)
+ ;;(eq chunk-is-closed values-is-closed)
+ (eq chunk-insertion-type-end values-insertion-type-end)
+ ;; fix-me: bmin bmax
+ ;;(and chunk-bmin values-bmin (= chunk-bmin values-bmin))
+ ;;(and chunk-bmax values-bmax (= chunk-bmax values-bmax))
+ )
+ ))
+
+(defvar mumamo-sub-chunk-families nil
+ "Chunk dividing routines for sub chunks.
+A major mode in a sub chunk can inherit chunk dividing routines
+from multi major modes. This is the way chunks in chunks is
+implemented.
+
+This variable is an association list with entries of the form
+
+ \(CHUNK-MAJOR CHUNK-FAMILY)
+
+where CHUNK-MAJOR is the major mode in a chunk and CHUNK-FAMILY
+is a chunk family \(ie the third argument to
+`define-mumamo-multi-major-mode'.
+
+You can use the function `mumamo-inherit-sub-chunk-family' to add
+to this list.")
+
+(defvar mumamo-multi-local-sub-chunk-families nil
+ "Multi major mode local chunk dividing rourines for sub chunks.
+Like `mumamo-sub-chunk-families' specific additions for multi
+major modes. The entries have the form
+
+ \((CHUNK-MAJOR . MULTI-MAJOR) CHUNK-FAMILY)
+
+Use the function `mumamo-inherit-sub-chunk-family-locally' to add
+to this list.")
+
+;;(mumamo-get-sub-chunk-funs 'html-mode)
+(defun mumamo-get-sub-chunk-funs (major)
+ "Get chunk family sub chunk with major mode MAJOR."
+ (let ((rec (or
+ (assoc (cons major mumamo-multi-major-mode) mumamo-multi-local-sub-chunk-families)
+ (assoc major mumamo-sub-chunk-families))))
+ (caddr (cadr rec))))
+
+(defun mumamo-inherit-sub-chunk-family-locally (multi-major multi-using)
+ "Add chunk dividing routines from MULTI-MAJOR locally.
+The dividing routines from multi major mode MULTI-MAJOR can then
+be used in sub chunks in buffers using multi major mode
+MULTI-USING."
+ (let* ((chunk-family (get multi-major 'mumamo-chunk-family))
+ (major (nth 1 chunk-family)))
+ (let ((major-mode major))
+ (when (derived-mode-p 'nxml-mode)
+ (error "Major mode %s major can't be used in sub chunks" major)))
+ (add-to-list 'mumamo-multi-local-sub-chunk-families
+ (list (cons major multi-using) chunk-family))))
+
+(defun mumamo-inherit-sub-chunk-family (multi-major)
+ "Inherit chunk dividing routines from multi major modes.
+Add chunk family from multi major mode MULTI-MAJOR to
+`mumamo-sub-chunk-families'.
+
+Sub chunks with major mode the same as MULTI-MAJOR mode will use
+this chunk familyu to find subchunks."
+ (let* ((chunk-family (get multi-major 'mumamo-chunk-family))
+ (major (nth 1 chunk-family)))
+ (let ((major-mode major))
+ (when (derived-mode-p 'nxml-mode)
+ (error "Major mode %s major can't be used in sub chunks" major)))
+ (add-to-list 'mumamo-sub-chunk-families (list major chunk-family))))
+
+(defun mumamo-find-next-chunk-values (after-chunk from after-change-max chunk-at-after-change)
+ "Search forward for start of next chunk.
+Return a list with chunk values for next chunk after AFTER-CHUNK
+and some values for the chunk after it.
+
+For the first chunk AFTER-CHUNK is nil. Otherwise the values in stored in AFTER-CHUNK
+is used to find the new chunk, its border etc.
+
+
+See also `mumamo-new-create-chunk' for more information."
+ ;;(msgtrc "(find-next-chunk-values %s %s %s %s)" after-chunk from after-change-max chunk-at-after-change)
+ ;;(mumamo-backtrace "find-next")
+ (when after-chunk
+ (unless (eq (overlay-buffer after-chunk)
+ (current-buffer))
+ (error "mumamo-find-next-chunk-values: after-chunk=%S, cb=%S" after-chunk (current-buffer))))
+ (let* ((here (point))
+ (max (point-max))
+ ;;(after-chunk-is-closed (when after-chunk-valid (overlay-get after-chunk 'mumamo-is-closed)))
+ (after-chunk-insertion-type-end (when after-chunk (overlay-get after-chunk 'mumamo-insertion-type-end)))
+ ;; Note that "curr-*" values are fetched from "mumamo-next-*" values in after-chunk
+ (curr-min (if after-chunk (overlay-end after-chunk) 1))
+ (curr-end-fun (when after-chunk
+ (mumamo-chunk-car after-chunk 'mumamo-next-end-fun)))
+ (curr-border-fun (when curr-end-fun (mumamo-chunk-car after-chunk 'mumamo-next-border-fun)))
+ (curr-syntax-min-max (when curr-border-fun (funcall curr-border-fun
+ (overlay-end after-chunk)
+ nil nil)))
+ (curr-syntax-min (or (car curr-syntax-min-max)
+ (when after-chunk (overlay-end after-chunk))
+ 1))
+ (search-from (or nil ;from
+ curr-syntax-min))
+ ;;(dummy (msgtrc "search-from=%s" search-from))
+ (main-chunk-funs (let ((chunk-info (cdr mumamo-current-chunk-family)))
+ (cadr chunk-info)))
+ (curr-major (if after-chunk
+ (or
+ ;; 'mumamo-next-major is used when we are going into a sub chunk.
+ (overlay-get after-chunk 'mumamo-next-major)
+ ;; We are going out of a sub chunk.
+ (mumamo-chunk-cadr after-chunk 'mumamo-major-mode))
+ (mumamo-main-major-mode)))
+ ;;(dummy (msgtrc "curr-major=%s" curr-major))
+ (curr-chunk-funs
+ (if (or (not after-chunk)
+ (= 0 (+ (overlay-get after-chunk 'mumamo-depth)
+ (overlay-get after-chunk 'mumamo-next-depth-diff))))
+ main-chunk-funs
+ (mumamo-get-sub-chunk-funs curr-major)))
+ curr-max
+ next-max
+ curr-max-found
+ next-min
+ curr-border-min
+ curr-border-max
+ curr-parseable
+ next-fw-exc-fun
+ next-indent
+ next-major
+ curr-end-fun-end
+ next-border-fun
+ ;; The insertion types for the new chunk
+ (curr-insertion-type-beg (when after-chunk after-chunk-insertion-type-end))
+ curr-insertion-type-end
+ next-depth-diff
+ r-point
+ )
+ (unless (and after-chunk-insertion-type-end
+ (= (1+ (buffer-size)) ;; ie point-max
+ (overlay-end after-chunk)))
+ (when (>= max search-from)
+ (when curr-end-fun
+ ;; If after-change-max is non-nil here then this function has
+ ;; been called after changes that are all in one chunk. We
+ ;; need to check if the chunk right border have been changed,
+ ;; but we do not have to look much longer than the max point
+ ;; of the change.
+ ;;(message "set after-change-max nil") (setq after-change-max nil)
+ (let* ((use-max (if nil ;;after-change-max
+ (+ after-change-max 100)
+ max))
+ (chunk-end (and chunk-at-after-change
+ (overlay-end chunk-at-after-change)))
+ ;;(use-min (max (- search-from 2) (point-min)))
+ (use-min curr-syntax-min)
+ (possible-end-fun-end t)
+ (end-search-pos use-min))
+ ;; The code below takes care of the case when to subsequent
+ ;; chunks have the same ending delimiter. (Maybe a while
+ ;; loop is bit overkill here.)
+ (while (and possible-end-fun-end
+ (not curr-end-fun-end)
+ (< end-search-pos use-max))
+ (setq curr-end-fun-end (funcall curr-end-fun end-search-pos use-max))
+ (if (not curr-end-fun-end)
+ (setq possible-end-fun-end nil)
+ (cond ((and t ;after-chunk-is-closed
+ (< curr-end-fun-end (overlay-end after-chunk)))
+ (setq curr-end-fun-end nil)
+ (setq end-search-pos (1+ end-search-pos)))
+ ;; See if the end is in code
+ ((let* ((syn2-min-max (when curr-border-fun
+ (funcall curr-border-fun
+ (overlay-end after-chunk)
+ curr-end-fun-end
+ nil)))
+ (syn2-max (or (cadr syn2-min-max)
+ curr-end-fun-end)))
+ (not (mumamo-end-in-code use-min syn2-max curr-major)))
+ (setq end-search-pos (1+ curr-end-fun-end))
+ (setq curr-end-fun-end nil)
+ ))))
+ (unless curr-end-fun-end
+ ;; Use old end if valid
+ (and after-change-max
+ chunk-end
+ (= -1 (overlay-get chunk-at-after-change 'mumamo-next-depth-diff))
+ (< after-change-max chunk-end)
+ chunk-end))
+ ;; Fix-me: Check if old chunk is valid. It is not valid if
+ ;; depth-diff = -1 and curr-end-fun-end is not the same as
+ ;; before.
+
+ ;; Fix-me: this test should also be made for other chunks
+ ;; searches, but this catches most problems I think.
+ ;; (or (not curr-end-fun-end)
+ ;; ;; Fix-me: The bug in wiki-090804-js.html indicates that
+ ;; ;; we should not subtract 1 here. The subchunk there
+ ;; ;; ends with and this can't be in column 1
+ ;; ;; when the line before ends with a // style js comment
+ ;; ;; unless we don't subtract 1.
+ ;; ;;
+ ;; ;; However wiki-strange-hili-080629.html does not work
+ ;; ;; then because then the final " in style="..." is
+ ;; ;; included in the scan done in mumamo-end-in-code.
+ ;; ;;
+ ;; ;; The solution is to check for the syntax borders here.
+ ;; (let* ((syn2-min-max (when curr-border-fun
+ ;; (funcall curr-border-fun
+ ;; (overlay-end after-chunk)
+ ;; curr-end-fun-end
+ ;; nil)))
+ ;; (syntax-max (or (cadr syn2-min-max)
+ ;; curr-end-fun-end)))
+ ;; ;;(mumamo-end-in-code syntax-min (- curr-end-fun-end 1) curr-major)
+ ;; ;;
+ ;; ;; fix-me: This should be really in the individual
+ ;; ;; routines that finds possible chunks. Mabye this is
+ ;; ;; possible to fix now when just looking forward for
+ ;; ;; chunks?
+ ;; (mumamo-end-in-code curr-syntax-min syntax-max curr-major)
+ ;; )
+ ;; (setq curr-end-fun-end nil))
+ ;; Use old result if valid
+ ;; (and nil ;(not curr-end-fun-end)
+ ;; chunk-at-after-change
+ ;; (= -1 (overlay-get chunk-at-after-change 'mumamo-next-depth-diff))
+ ;; (setq curr-end-fun-end (overlay-end chunk-at-after-change)))
+ ;;(msgtrc "find-next-chunk-values:curr-end-fun-end after end-in-code=%s" curr-end-fun-end)
+ ))
+ ;;(msgtrc "find-next-chunk-values:here d, curr-min=%s, after-chunk=%s" curr-min after-chunk)
+ (when (listp curr-chunk-funs)
+ ;;(msgtrc "find-next-chunk-values:curr-chunk-funs=%s" curr-chunk-funs)
+ (setq r-point (point))
+ (dolist (fn curr-chunk-funs)
+ ;;(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)
+ (assert (= r-point (point)) t)
+ (let* ((r (funcall fn search-from search-from max))
+ (rmin (nth 0 r))
+ (rmax (nth 1 r))
+ (rmajor-sub (nth 2 r))
+ (rborder (nth 3 r))
+ (rparseable (nth 4 r))
+ (rfw-exc-fun (nth 5 r))
+ (rborder-fun (nth 6 r))
+ (rindent (nth 7 r))
+ (rborder-min (when rborder (nth 0 rborder)))
+ (rborder-max (when rborder (nth 1 rborder)))
+ ;;(rmin-found rmin)
+ )
+ ;;(msgtrc "find-next-chunk-values:fn=%s, r=%s" fn r)
+ (goto-char r-point)
+ (when r
+ (when rmax (message "mumamo warning: Bad r=%s, nth 1 should be nil" r))
+ (unless (or rmin rmax)
+ (error "Bad r=%s, fn=%s" r fn))
+ (unless rfw-exc-fun
+ (error "No fw-exc-fun returned from fn=%s, r=%s" fn r))
+ (unless rmajor-sub
+ (error "No major mode for sub chunk, fn=%s, r=%s" fn r)))
+ (when r
+ (mumamo-msgfntfy " fn=%s, r=%s" fn r)
+ (unless rmin (setq rmin (point-max)))
+ ;;(unless rmax (setq rmax (point-min)))
+ ;; Do not allow zero length chunks
+ (unless rmax (setq rmax (point-max)))
+ (unless (and (> rmin 1)
+ rmax
+ (= rmin rmax))
+ ;; comparision have to be done differently if we are in an
+ ;; exception part or not. since we are doing this from top to
+ ;; bottom the rules are:
+ ;;
+ ;; - exception parts always outrules non-exception part. when
+ ;; in exception part the min start point should be used.
+ ;; - when in non-exception part the max start point and the
+ ;; min end point should be used.
+ ;;
+ ;; check if first run:
+
+ ;; Fix-me: there is some bug here when borders are not
+ ;; included and are not 0 width.
+ (if (not next-min)
+ (progn
+ (setq next-min rmin)
+ (setq curr-border-min rborder-min)
+ (setq next-max rmax)
+ (setq curr-border-max rborder-max)
+ ;;(setq curr-max-found rmin-found)
+ (setq curr-parseable rparseable)
+ (setq next-fw-exc-fun rfw-exc-fun)
+ (setq next-border-fun rborder-fun)
+ (setq next-indent rindent)
+ (setq next-major rmajor-sub))
+ (if rmajor-sub
+ (if next-major
+ (when (or (not next-min)
+ (< rmin next-min))
+ (setq next-min rmin)
+ (setq curr-border-min rborder-min)
+ (when rmax (setq max rmax))
+ (setq curr-border-max rborder-max)
+ ;;(when rmin-found (setq curr-max-found t))
+ (setq curr-parseable rparseable)
+ (setq next-fw-exc-fun rfw-exc-fun)
+ (setq next-border-fun rborder-fun)
+ (setq next-indent rindent)
+ (setq next-major rmajor-sub))
+ (setq next-min rmin)
+ (setq curr-border-min rborder-min)
+ (when rmax (setq max rmax))
+ (setq curr-border-max rborder-max)
+ ;;(when rmin-found (setq curr-max-found t))
+ (setq curr-parseable rparseable)
+ (setq next-fw-exc-fun rfw-exc-fun)
+ (setq next-border-fun rborder-fun)
+ (setq next-indent rindent)
+ (setq next-major rmajor-sub))
+ (unless next-major
+ (when (> next-min rmin)
+ (setq next-min rmin)
+ (setq curr-border-min rborder-min))
+ (when (and rmax max
+ (> rmax max))
+ ;;(setq max-found rmin-found)
+ ;;(when rmin-found (setq curr-max-found t))
+ (when rmax (setq max rmax))
+ (setq curr-border-max rborder-max))
+ ))))
+ (mumamo-msgfntfy "next-min/max=%s/%s border=%s/%s search-from=%s" next-min max curr-border-min curr-border-max search-from)
+ ;; check!
+ (when (and next-min max)
+ ;;(assert (>= next-min search-from) t)
+ (assert (<= search-from max) t)
+ (when curr-border-min
+ (assert (<= next-min curr-border-min) t)
+ (assert (<= curr-border-min max) t))
+ (when curr-border-max
+ (assert (<= next-min curr-border-max) t)
+ (assert (<= curr-border-max max) t))))
+ )))
+ (goto-char here)
+ (setq curr-max-found (or curr-max-found curr-end-fun-end))
+ (when t ;curr-max-found
+ (setq curr-max (if max max (point-max)))
+ (setq curr-max (min (if next-min next-min curr-max)
+ (if curr-end-fun-end curr-end-fun-end curr-max))))
+ ;;(setq curr-max nil)
+ (setq next-depth-diff (cond
+ ( (and curr-max curr-end-fun-end
+ (= curr-max curr-end-fun-end))
+ -1)
+ ( (= curr-max (1+ (buffer-size)))
+ 0)
+ ( t 1)))
+ (when (= -1 next-depth-diff) ;; We will pop it from 'mumamo-major-mode
+ (setq next-major nil))
+ (when curr-max
+ (unless (>= curr-max curr-min)
+ (error "curr-max is not >= curr-min")))
+ ;;(setq curr-is-closed (and curr-max (< 1 curr-max)))
+ (when (and curr-max (= 1 curr-max))
+ (assert (mumamo-fun-eq curr-major (mumamo-main-major-mode)) t)
+ )
+ (assert (symbolp next-major) t)
+ ;; Fix-me: see for example rr-min8.php
+ (when (or ;;(not after-chunk)
+ (= curr-max (1+ (buffer-size)))
+ (cond
+ ((= next-depth-diff 1)
+ next-border-fun)
+ ((= next-depth-diff -1)
+ next-border-fun)
+ ((= next-depth-diff 0)
+ t)
+ (t (error "next-depth-diff=%s" next-depth-diff))))
+ (setq curr-insertion-type-end t))
+ (let ((current (list curr-min curr-max curr-major curr-border-min curr-border-max curr-parseable
+ curr-chunk-funs after-chunk
+ ;;curr-is-closed
+ curr-insertion-type-beg
+ curr-insertion-type-end
+ ))
+ (next (list next-major next-fw-exc-fun next-border-fun next-depth-diff next-indent)))
+ ;;(msgtrc "find-next-chunk-values=> current=%s, next=%s" current next)
+ (list current next))))))
+
+;; Fix-me: This should check if the new chunk should be
+;; parsed or not
+;; (defsubst mumamo-chunk-nxml-parseable (chunk)
+;; (mumamo-fun-eq (mumamo-main-major-mode)
+;; (mumamo-chunk-major-mode xml-chunk)))
+
+(defun mumamo-valid-nxml-point (pos)
+ "Return non-nil if position POS is in an XML chunk."
+ (memq 'nxml-mode (get-text-property pos 'mumamo-parseable-by)))
+
+(defun mumamo-valid-nxml-chunk (chunk)
+ "Return t if chunk CHUNK should be valid XML."
+ (when chunk
+ (let ((major-mode (mumamo-chunk-major-mode chunk))
+ (region (overlay-get chunk 'mumamo-region))
+ (parseable-by (overlay-get chunk 'mumamo-parseable-by)))
+ ;;(message "mumamo-valid-nxml-chunk: major-mode=%s, parseble-by=%s" major-mode parseable-by)
+ (or region
+ (derived-mode-p 'nxml-mode)
+ (memq 'nxml-mode parseable-by)))))
+
+;; A good test case for the use of this is the troublesome code in the
+;; first line of xml-as-string.php in nxml/nxhtml/bug-tests. Currently
+;; this test code is however splitted and it looks like the code below
+;; can't handle the line above if the line looks like below. The ?> is
+;; still thought to be a border. Does this mean that ' is not treated
+;; as a string separator?
+;;
+;; '; ?>
+;;
+;; However there are the reverse cases also, in lines like
+;;
+;; href="url($url); ?>"
+;; . Could this be solved by RMS suggestion with a
+ ;; function/defmacro that binds variables to their global values?
+ (mumamo-msgfntfy "point-min,max=%s,%s syntax-start,end=%s,%s, major=%s" (point-min) (point-max) syntax-start syntax-end major)
+ ;;(msgtrc "end-in-code:here a after-chunk=%s" (when (boundp 'after-chunk) after-chunk))
+ (assert (and syntax-start syntax-end) t)
+ (let ((doesnt-here (point))
+ doesnt-ret)
+ (save-restriction
+ (widen)
+ ;;(msgtrc "end-in-code:here a2 after-chunk=%s" (when (boundp 'after-chunk) after-chunk))
+ (mumamo-with-major-mode-fontification major
+ `(let (ppss)
+ ;; fix-me: Use main major mode, and `syntax-ppss'. Change the
+ ;; defadvice of this to make that possible.
+ ;;(msgtrc "end-in-code:here b after-chunk=%s" (when (boundp 'after-chunk) after-chunk))
+ (setq ppss (parse-partial-sexp ,syntax-start (+ ,syntax-end 0)))
+ ;;(msgtrc "end-in-code %s %s %s:ppss=%S" ,syntax-start ,syntax-end ',major ppss)
+ ;;(msgtrc "end-in-code:here c after-chunk=%s" (when (boundp 'after-chunk) after-chunk))
+ ;; If inside a string or comment then the end marker is
+ ;; invalid:
+ ;;(msgtrc "mumamo-end-in-code:ppss=%s" ppss)
+ (if (or (nth 3 ppss)
+ (nth 4 ppss))
+ (progn
+ ;;(msgtrc "invalid end, syntax-end =%s" syntax-end)
+ (setq doesnt-ret nil)
+ (if (nth 4 ppss) ;; in comment, check if single line comment
+ (let ((here (point))
+ eol-pos)
+ ;;(msgtrc "end-in-code, was in comment, ppss=%S" ppss)
+ (goto-char ,syntax-end)
+ (setq eol-pos (line-end-position))
+ (goto-char here)
+ (setq ppss (parse-partial-sexp ,syntax-start (+ eol-pos 1)))
+ ;;(msgtrc "end-in-code, in comment, new ppss %s %s=%S" ,syntax-start (+ eol-pos 1) ppss)
+ (unless (nth 4 ppss)
+ (setq doesnt-ret t)))))
+ (setq doesnt-ret t)
+ ;;(msgtrc "valid end, syntax-end =%s" syntax-end)
+ ))))
+ (goto-char doesnt-here)
+ ;;(msgtrc "end-in-code:ret=%s" doesnt-ret)
+ doesnt-ret))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Easy chunk defining
+
+(defun mumamo-quick-chunk-forward (pos
+ min max
+ begin-mark end-mark inc mode
+ mark-is-border)
+ ;;(msgtrc "quick-chunk-forward %s %s %s" pos min max)
+ (let ((search-fw-exc-start
+ `(lambda (pos max)
+ (let ((exc-start
+ (if ,inc
+ (mumamo-chunk-start-fw-str-inc pos max ,begin-mark)
+ (mumamo-chunk-start-fw-str pos max ,begin-mark))))
+ (when exc-start
+ (list exc-start mode nil)))))
+ (search-fw-exc-end
+ `(lambda (pos max)
+ ;;(msgtrc "search-fw-exc-end %s %s, inc=%s, end-mark=%s" pos max ,inc ,end-mark)
+ (save-match-data
+ (let ((ret (if ,inc
+ (mumamo-chunk-end-fw-str-inc pos max ,end-mark)
+ (mumamo-chunk-end-fw-str pos max ,end-mark))))
+ ;;(msgtrc "search-fw-exc-end ret=%s" ret)
+ ret))))
+ (find-borders
+ (when mark-is-border
+ `(lambda (start end exc-mode)
+ (let ((start-border)
+ (end-border))
+ (if (and ,inc);; exc-mode)
+ (progn
+ (when start
+ (setq start-border
+ (+ start (length ,begin-mark))))
+ (when end
+ (setq end-border
+ (- end (length ,end-mark)))))
+ (if (and (not ,inc) (not exc-mode))
+ (progn
+ (when start
+ (setq start-border
+ (+ start (length ,end-mark))))
+ (when end
+ (setq end-border
+ (- end (length ,begin-mark)))))))
+ (when (or start-border end-border)
+ (mumamo-msgfntfy "quick.start-border/end=%s/%s, start/end=%s/%s exc-mode=%s" start-border end-border start end exc-mode)
+ (list start-border end-border)))))))
+ (mumamo-possible-chunk-forward pos max
+ search-fw-exc-start
+ search-fw-exc-end
+ find-borders)))
+
+(defun mumamo-quick-static-chunk (pos
+ min max
+ begin-mark end-mark inc mode
+ mark-is-border)
+ (if t
+ (mumamo-quick-chunk-forward pos min max begin-mark end-mark inc mode mark-is-border)
+ ;; (let ((old (mumamo-quick-static-chunk-old pos min max begin-mark end-mark inc mode mark-is-border))
+ ;; (new (mumamo-quick-chunk-forward pos min max begin-mark end-mark inc mode mark-is-border)))
+ ;; (unless (equal old new) (msgtrc "equal=%s\n\told=%S\n\tnew=%S" (equal old new) old new))
+ ;; (if nil old new))
+ ))
+
+;; (defun mumamo-quick-static-chunk-old (pos
+;; min max
+;; begin-mark end-mark inc mode
+;; mark-is-border)
+;; "Quick way to make a chunk function with static dividers.
+;; Here is an example of how to use it:
+
+;; (defun mumamo-chunk-embperl-<- (pos min max)
+;; \"Find [- ... -], return range and perl-mode.\"
+;; (mumamo-quick-static-chunk pos min max \"[-\" \"-]\" nil 'perl-mode))
+
+;; As you can see POS, MIN and MAX comes from argument of the
+;; function you define.
+
+;; BEGIN-MARK should be a string that begins the chunk.
+;; END-MARK should be a string that ends the chunk.
+
+;; If INC is non-nil then the dividers are included in the chunk.
+;; Otherwise they are instead made parts of the surrounding chunks.
+
+;; MODE should be the major mode for the chunk.
+
+;; If MARK-IS-BORDER is non-nil then the marks are just borders and
+;; not supposed to have the same syntax as the inner part of the
+
+;; Fix-me: This can only be useful if the marks are included in the
+;; chunk, ie INC is non-nil. Should not these two arguments be
+;; mixed then?
+;; "
+;; (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)
+;; (let ((search-bw-exc-start
+;; `(lambda (pos min)
+;; (let ((exc-start
+;; (if ,inc
+;; (mumamo-chunk-start-bw-str-inc pos min begin-mark)
+;; (mumamo-chunk-start-bw-str pos min begin-mark))))
+;; (when (and exc-start
+;; (<= exc-start pos))
+;; (cons exc-start mode)))))
+;; (search-bw-exc-end
+;; `(lambda (pos min)
+;; (if ,inc
+;; (mumamo-chunk-end-bw-str-inc pos min ,end-mark)
+;; (mumamo-chunk-end-bw-str pos min ,end-mark))))
+;; (search-fw-exc-start
+;; `(lambda (pos max)
+;; (if ,inc
+;; (mumamo-chunk-start-fw-str-inc pos max ,begin-mark)
+;; (mumamo-chunk-start-fw-str pos max ,begin-mark))))
+;; (search-fw-exc-end
+;; `(lambda (pos max)
+;; (save-match-data
+;; (if ,inc
+;; (mumamo-chunk-end-fw-str-inc pos max ,end-mark)
+;; (mumamo-chunk-end-fw-str pos max ,end-mark)))))
+;; (find-borders
+;; (when mark-is-border
+;; `(lambda (start end exc-mode)
+;; (let ((start-border)
+;; (end-border))
+;; (if (and ,inc exc-mode)
+;; (progn
+;; (when start
+;; (setq start-border
+;; (+ start (length ,begin-mark))))
+;; (when end
+;; (setq end-border
+;; (- end (length ,end-mark)))))
+;; (if (and (not ,inc) (not exc-mode))
+;; (progn
+;; (when start
+;; (setq start-border
+;; (+ start (length ,end-mark))))
+;; (when end
+;; (setq end-border
+;; (- end (length ,begin-mark)))))))
+;; (when (or start-border end-border)
+;; (mumamo-msgfntfy "quick.start-border/end=%s/%s, start/end=%s/%s exc-mode=%s" start-border end-border start end exc-mode)
+;; (list start-border end-border)))))))
+;; (mumamo-find-possible-chunk pos min max
+;; search-bw-exc-start
+;; search-bw-exc-end
+;; search-fw-exc-start
+;; search-fw-exc-end
+;; find-borders)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Changing the major mode that the user sees
+
+(defvar mumamo-unread-command-events-timer nil)
+(make-variable-buffer-local 'mumamo-unread-command-events-timer)
+
+(defun mumamo-unread-command-events (command-keys new-major old-last-command)
+ "Sync new keymaps after changing major mode in a timer.
+Also tell new major mode.
+
+COMMAND-KEYS is the keys entered after last command and the call
+to `mumamo-idle-set-major-mode' \(which is done in an idle
+timer). Those keys are added to `unread-command-events' so they
+can be used in the new keymaps. They should be in the format
+returned by
+
+ \(listify-key-sequence (this-command-keys-vector))
+
+NEW-MAJOR mode is the new major mode.
+
+OLD-LAST-COMMAND is the value of `last-command' after switching
+major mode. \(This is cleared by the function `top-level' so
+this function will not see it since it is run in a timer.)"
+ (mumamo-condition-case err
+ (progn
+ ;; last-command seems to be cleared by top-level so set it
+ ;; back here.
+ (unless last-command
+ (setq last-command old-last-command))
+ (when (< 0 (length command-keys))
+ ;;(setq last-command-char nil) ;; For `viper-command-argument'
+ (setq unread-command-events (append command-keys nil)))
+ (message "Switched to %s" new-major))
+ (error
+ (let ((mumamo-display-error-lwarn t))
+ (mumamo-display-error 'mumamo-unread-command-events "err=%s" err)))))
+
+(defvar mumamo-idle-set-major-mode-timer nil)
+(make-variable-buffer-local 'mumamo-idle-set-major-mode-timer)
+(put 'mumamo-idle-set-major-mode-timer 'permanent-local t)
+
+(defun mumamotemp-pre-command ()
+ "Temporary command for debugging."
+ (message "mumamotemp-pre 1: modified=%s %s" (buffer-modified-p) (current-buffer)))
+(defun mumamotemp-post-command ()
+ "Temporary command for debugging."
+ (message "mumamotemp-post 1: modified=%s %s" (buffer-modified-p) (current-buffer)))
+(put 'mumamotemp-pre-command 'permanent-local-hook t)
+(put 'mumamotemp-post-command 'permanent-local-hook t)
+(defun mumamotemp-start ()
+ "Temporary command for debugging."
+ (add-hook 'post-command-hook 'mumamotemp-post-command nil t)
+ (add-hook 'pre-command-hook 'mumamotemp-pre-command nil t))
+
+(defsubst mumamo-cancel-idle-set-major-mode ()
+ (when (timerp mumamo-idle-set-major-mode-timer)
+ (cancel-timer mumamo-idle-set-major-mode-timer))
+ (setq mumamo-idle-set-major-mode-timer nil))
+
+(defun mumamo-request-idle-set-major-mode ()
+ "Setup to change major mode from chunk when Emacs is idle."
+ (mumamo-cancel-idle-set-major-mode)
+ (setq mumamo-idle-set-major-mode-timer
+ (run-with-idle-timer
+ mumamo-set-major-mode-delay
+ nil
+ 'mumamo-idle-set-major-mode (current-buffer) (selected-window))))
+
+(defvar mumamo-done-first-set-major nil)
+(make-variable-buffer-local 'mumamo-done-first-set-major)
+(put 'mumamo-done-first-set-major 'permanent-local t)
+
+;; Fix-me: Add a property to the symbol instead (like in CUA).
+(defvar mumamo-safe-commands-in-wrong-major
+ '(self-insert-command
+ fill-paragraph ;; It changes major mode
+ forward-char
+ viper-forward-char
+ backward-char
+ viper-backward-char
+ next-line
+ viper-next-line
+ previous-line
+ viper-previous-line
+ scroll-down
+ cua-scroll-down
+ scroll-up
+ cua-scroll-up
+ move-beginning-of-line
+ move-end-of-line
+ nonincremental-search-forward
+ nonincremental-search-backward
+ mumamo-backward-chunk
+ mumamo-forward-chunk
+ ;; Fix-me: add more
+ )
+ )
+
+(defun mumamo-fetch-local-map (major)
+ "Fetch local keymap for major mode MAJOR.
+Do that by turning on the major mode in a new buffer. Add the
+keymap to `mumamo-major-modes-local-maps'.
+
+Return the fetched local map."
+ (let (temp-buf-name
+ temp-buf
+ local-map)
+ (setq temp-buf-name (concat "mumamo-fetch-major-mode-local-"
+ (symbol-name major)))
+ (setq temp-buf (get-buffer temp-buf-name))
+ (when temp-buf (kill-buffer temp-buf))
+ (setq temp-buf (get-buffer-create temp-buf-name))
+ (with-current-buffer temp-buf
+ (let ((mumamo-fetching-major t))
+ (funcall major))
+ (setq local-map (current-local-map))
+ (when local-map (setq local-map (copy-keymap (current-local-map))))
+ (add-to-list 'mumamo-major-modes-local-maps
+ (cons major-mode local-map)))
+ (kill-buffer temp-buf)
+ local-map))
+
+(defvar mumamo-post-command-chunk nil)
+(make-variable-buffer-local 'mumamo-post-command-chunk)
+
+(defun mumamo-post-command-get-chunk (pos)
+ "Get chunk at POS fast."
+ (let ((have-regions (and (boundp 'mumamo-regions)
+ mumamo-regions)))
+ (when have-regions (setq mumamo-post-command-chunk nil))
+ (if (and mumamo-post-command-chunk
+ (overlayp mumamo-post-command-chunk)
+ ;;(progn (message "here a=%s" mumamo-post-command-chunk) t)
+ (overlay-buffer mumamo-post-command-chunk)
+ ;;(progn (message "here b=%s" mumamo-post-command-chunk) t)
+ (< pos (overlay-end mumamo-post-command-chunk))
+ ;;(progn (message "here c=%s" mumamo-post-command-chunk) t)
+ (>= pos (overlay-start mumamo-post-command-chunk))
+ ;;(progn (message "here d=%s" mumamo-post-command-chunk) t)
+ (mumamo-chunk-major-mode mumamo-post-command-chunk)
+ ;;(progn (msgtrc "here e=%s" mumamo-post-command-chunk) t)
+ )
+ mumamo-post-command-chunk
+ ;;(msgtrc "--------------- new post-command-chunk")
+ (setq mumamo-post-command-chunk
+ (or (unless have-regions (mumamo-get-existing-new-chunk-at (point) nil))
+ (mumamo-find-chunks (point) "post-command-get-chunk"))))))
+
+;; (setq mumamo-set-major-mode-delay 10)
+(defun mumamo-set-major-post-command ()
+ "Change major mode if necessary after a command.
+If the major mode for chunk at `window-point' differ from current
+major mode then change major mode to that for the chunk. If
+however `mumamo-set-major-mode-delay' is greater than 0 just
+request a change of major mode when Emacs is idle that long.
+
+See the variable above for an explanation why a delay might be
+needed \(and is the default)."
+ ;;(msgtrc "set-major-post-command here")
+ (let* ((in-pre-hook (memq 'mumamo-set-major-pre-command pre-command-hook))
+ (ovl (unless in-pre-hook (mumamo-post-command-get-chunk (point))))
+ (major (when ovl (mumamo-chunk-major-mode ovl)))
+ (set-it-now (not (or in-pre-hook (mumamo-fun-eq major major-mode)))))
+ ;;(msgtrc "set-major-post-command ovl=%s, in-pre-hook=%s" ovl in-pre-hook)
+ (if (not set-it-now)
+ (unless (mumamo-fun-eq major major-mode)
+ (when mumamo-idle-set-major-mode-timer
+ (mumamo-request-idle-set-major-mode)))
+ (if mumamo-done-first-set-major
+ (if (<= 0 mumamo-set-major-mode-delay)
+ ;; Window point has been moved to a new chunk with a new
+ ;; major mode. Major mode will not be changed directly,
+ ;; but in an idle timer or in pre-command-hook. To avoid
+ ;; that the user get the wrong key bindings for the new
+ ;; chunk fetch the local map directly and apply that.
+ (let* ((map-rec (assoc major mumamo-major-modes-local-maps))
+ (map (cdr map-rec)))
+ (unless map
+ (setq map (mumamo-fetch-local-map major)))
+ (unless (eq map 'no-local-map)
+ (use-local-map map))
+ (add-hook 'pre-command-hook 'mumamo-set-major-pre-command nil t)
+ (mumamo-request-idle-set-major-mode))
+ (mumamo-set-major major ovl)
+ (message "Switched to %s" major-mode))
+ (mumamo-set-major major ovl)))))
+
+(defun mumamo-set-major-pre-command ()
+ "Change major mode if necessary before a command.
+When the key sequence that invoked the command is in current
+local map and major mode is not the major mode for the current
+mumamo chunk then set major mode to that for the chunk."
+ (mumamo-condition-case err
+ ;; First see if we can avoid changing major mode
+ (if (memq this-command mumamo-safe-commands-in-wrong-major)
+ (mumamo-request-idle-set-major-mode)
+ ;;(message "pre point=%s" (point))
+ (let* ((ovl (mumamo-find-chunks (point) "mumamo-set-major-pre-command"))
+ (major (mumamo-chunk-major-mode ovl)))
+ ;;(message "pre point=%s" (point))
+ (if (not major)
+ (lwarn '(mumamo-set-major-pre-command) :error "major=%s" major)
+ (when (or (not (mumamo-fun-eq major-mode major))
+ (not (mumamo-set-major-check-keymap)))
+ (setq major-mode nil)
+ (mumamo-set-major major ovl)
+ ;; Unread the last command key sequence
+ (setq unread-command-events
+ (append (listify-key-sequence (this-command-keys-vector))
+ unread-command-events))
+ ;; Some commands, like `viper-command-argument' need to
+ ;; know the last command, so tell them.
+ (setq this-command (lambda ()
+ (interactive)
+ (setq this-command last-command)))))))
+ (error
+ (mumamo-display-error 'mumamo-set-major-pre-command
+ "cb:%s, %s" (current-buffer) (error-message-string err)))))
+
+(defun mumamo-idle-set-major-mode (buffer window)
+ "Set major mode from mumamo chunk when Emacs is idle.
+Do this only if current buffer is BUFFER and then do it in window
+WINDOW.
+
+See the variable `mumamo-set-major-mode-delay' for an
+explanation."
+ (save-match-data ;; runs in idle timer
+ (mumamo-msgfntfy "mumamo-idle-set-major-mode b=%s, window=%s" buffer window)
+ (with-selected-window window
+ ;; According to Stefan Monnier we need to set the buffer too.
+ (with-current-buffer (window-buffer window)
+ (when (eq buffer (current-buffer))
+ (mumamo-condition-case err
+ ;;(let* ((ovl (mumamo-get-chunk-at (point)))
+ ;;(message "idle point=%s" (point))
+ (let* ((ovl (mumamo-find-chunks (point) "mumamo-idle-set-major-mode"))
+ (major (mumamo-chunk-major-mode ovl))
+ (modified (buffer-modified-p)))
+ ;;(message "idle point=%s" (point))
+ (unless (mumamo-fun-eq major major-mode)
+ ;;(message "mumamo-set-major at A")
+ (mumamo-set-major major ovl)
+ ;; Fix-me: This is a bug workaround. Possibly in Emacs.
+ (when (and (buffer-modified-p)
+ (not modified))
+ (set-buffer-modified-p nil))
+ ;; sync keymap
+ (when (timerp mumamo-unread-command-events-timer)
+ (cancel-timer mumamo-unread-command-events-timer))
+ (when unread-command-events
+ ;; Save unread keys before calling `top-level' which
+ ;; will clear them.
+ (setq mumamo-unread-command-events-timer
+ (run-with-idle-timer
+ 0 nil
+ 'mumamo-unread-command-events
+ unread-command-events
+ major last-command))
+ (top-level)
+ )))
+ (error
+ (mumamo-display-error 'mumamo-idle-set-major-mode
+ "cb=%s, err=%s" (current-buffer) err))))))))
+
+(defun mumamo-post-command-1 (&optional no-debug)
+ "See `mumamo-post-command'.
+Turn on `debug-on-error' unless NO-DEBUG is nil."
+ (unless no-debug (setq debug-on-error t))
+ (setq mumamo-find-chunks-level 0)
+ (mumamo-msgfntfy "mumamo-post-command-1 ENTER: font-lock-mode=%s" font-lock-mode)
+ (if font-lock-mode
+ (mumamo-set-major-post-command)
+ ;;(mumamo-on-font-lock-off)
+ )
+ ;;(msgtrc "mumamo-post-command-1 EXIT: font-lock-keywords-only =%s" (default-value 'font-lock-keywords-only))
+ )
+
+
+
+
+(defvar mumamo-bug-3467-w14 41)
+(defvar mumamo-bug-3467-w15 51)
+;;(mumamo-check-has-bug3467 t)
+;;(kill-local-variable 'mumamo-bug-3467-w14)
+(defun mumamo-check-has-bug3467 (verbose)
+ (let ((has-bug nil))
+ (with-temp-buffer
+ (let ((mumamo-bug-3467-w14 42)
+ (mumamo-bug-3467-w15 52))
+ (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)))
+ (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)))
+ (set (make-local-variable 'mumamo-bug-3467-w14) 43)
+ (set-default 'mumamo-bug-3467-w14 44)
+ (set-default 'mumamo-bug-3467-w15 54)
+ (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)))
+ (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))))
+ (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)))
+ (when (/= mumamo-bug-3467-w14 43) (setq has-bug t))
+ (when (/= (default-value 'mumamo-bug-3467-w14) 41) (setq has-bug t))
+ (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)))
+ )
+ (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)))
+ (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)))
+ (or has-bug
+ (local-variable-p 'mumamo-bug-3467-w14)
+ (/= (default-value 'mumamo-bug-3467-w14) 41)
+ )
+ ))
+
+(defvar mumamo-has-bug3467 (mumamo-check-has-bug3467 nil))
+
+(defun mumamo-emacs-start-bug3467-timer-if-needed ()
+ "Work around for Emacs bug 3467. The only one I have found."
+ (when mumamo-has-bug3467
+ (run-with-idle-timer 0 nil 'mumamo-emacs-bug3467-workaround)))
+
+(defun mumamo-emacs-bug3467-workaround ()
+ "Work around for Emacs bug 3467. The only one I have found."
+ (set-default 'font-lock-keywords-only nil))
+
+
+
+
+(defun mumamo-post-command ()
+ "Run this in `post-command-hook'.
+Change major mode if necessary."
+ ;;(msgtrc "mumamo-post-command")
+ (when mumamo-multi-major-mode
+ (mumamo-condition-case err
+ (mumamo-post-command-1 t)
+ (error
+ (mumamo-msgfntfy "mumamo-post-command %S" err)
+ ;; Warnings are to disturbing when run in post-command-hook,
+ ;; but this message is important so show it with an highlight.
+ (message
+ (propertize
+ "%s\n- Please try M-: (mumamo-post-command-1) to see what happened."
+ 'face 'highlight)
+ (error-message-string err))))))
+
+(defun mumamo-change-major-function ()
+ "Function added to `change-major-mode-hook'.
+Remove mumamo when changing to a new major mode if the change is
+not done because point was to a new chunk."
+ (unless mumamo-set-major-running
+ (mumamo-turn-off-actions)))
+
+(defun mumamo-derived-from-mode (major from-mode)
+ "Return t if major mode MAJOR is derived from FROM-MODE."
+ (let ((major-mode major))
+ (derived-mode-p from-mode)))
+
+;; This is the new version of add-hook. For its origin see
+;; http://lists.gnu.org/archive/html/emacs-devel/2007-12/msg00169.html
+;;
+;;(unless (> emacs-major-version 22)
+(defvar mumamo-test-add-hook nil
+ "Internal use.")
+(unless (and t
+ (let ((has-it nil))
+ ;;(add-hook 'mumamo-test-add-hook 'mumamo-jit-lock-after-change nil t)
+ (add-hook 'mumamo-test-add-hook 'mumamo-after-change nil t)
+ (setq has-it (eq 'permanent-local-hook
+ (get 'mumamo-test-add-hook 'permanent-local)))
+ has-it))
+ (defun add-hook (hook function &optional append local)
+ "Add to the value of HOOK the function FUNCTION.
+FUNCTION is not added if already present.
+FUNCTION is added (if necessary) at the beginning of the hook list
+unless the optional argument APPEND is non-nil, in which case
+FUNCTION is added at the end.
+
+The optional fourth argument, LOCAL, if non-nil, says to modify
+the hook's buffer-local value rather than its default value.
+This makes the hook buffer-local if needed, and it makes t a member
+of the buffer-local value. That acts as a flag to run the hook
+functions in the default value as well as in the local value.
+
+HOOK should be a symbol, and FUNCTION may be any valid function. If
+HOOK is void, it is first set to nil. If HOOK's value is a single
+function, it is changed to a list of functions."
+ (or (boundp hook) (set hook nil))
+ (or (default-boundp hook) (set-default hook nil))
+ (if local (unless (local-variable-if-set-p hook)
+ (set (make-local-variable hook) (list t)))
+ ;; Detect the case where make-local-variable was used on a hook
+ ;; and do what we used to do.
+ (unless (and (consp (symbol-value hook)) (memq t (symbol-value hook)))
+ (setq local t)))
+ (let ((hook-value (if local (symbol-value hook) (default-value hook))))
+ ;; If the hook value is a single function, turn it into a list.
+ (when (or (not (listp hook-value)) (eq (car hook-value) 'lambda))
+ (setq hook-value (list hook-value)))
+ ;; Do the actual addition if necessary
+ (unless (member function hook-value)
+ (setq hook-value
+ (if append
+ (append hook-value (list function))
+ (cons function hook-value))))
+ ;; Set the actual variable
+ (if local
+ (progn
+ ;; If HOOK isn't a permanent local,
+ ;; but FUNCTION wants to survive a change of modes,
+ ;; mark HOOK as partially permanent.
+ (and (symbolp function)
+ (get function 'permanent-local-hook)
+ (not (get hook 'permanent-local))
+ (put hook 'permanent-local 'permanent-local-hook))
+ (set hook hook-value))
+ (set-default hook hook-value))))
+ )
+
+
+(defvar mumamo-survive-hooks
+ '(
+ ;; activate-mark-hook after-change-functions after-save-hook
+ ;; before-save-functions auto-save-hook before-revert-hook
+ ;; buffer-access-fontify-functions calendar-load-hook
+ ;; command-line-functions compilation-finish-function
+ ;; deactivate-mark-hook find-file-hook
+ ;; find-file-not-found-functions first-change-hook
+ ;; kbd-macro-termination-hook kill-buffer-hook
+ ;; kill-buffer-query-functions menu-bar-update-hook
+ ;; post-command-hook pre-abbrev-expand-hook pre-command-hook
+ ;; write-contents-functions write-file-functions
+ ;; write-region-annotate-functions
+ ;; c-special-indent-hook
+ ))
+
+;;
+;; Emulation modes
+;;
+;; These variables should have 'permanant-local t set in their
+;; packages IMO, but now they do not have that.
+(eval-after-load 'viper-cmd
+ (progn
+ (put 'viper-after-change-functions 'permanent-local t)
+ (put 'viper-before-change-functions 'permanent-local t)
+ ))
+(eval-after-load 'viper
+ (progn
+ (put 'viper-post-command-hooks 'permanent-local t)
+ (put 'viper-pre-command-hooks 'permanent-local t)
+ ;;minor-mode-map-alist
+ ;; viper-mode-string -- is already buffer local, globally void
+ (put 'viper-mode-string 'permanent-local t)
+ ))
+;;viper-tut--part
+(eval-after-load 'viper-init
+ (progn
+ (put 'viper-d-com 'permanent-local t)
+ (put 'viper-last-insertion 'permanent-local t)
+ (put 'viper-command-ring 'permanent-local t)
+ (put 'viper-vi-intercept-minor-mode 'permanent-local t)
+ (put 'viper-vi-basic-minor-mode 'permanent-local t)
+ (put 'viper-vi-local-user-minor-mode 'permanent-local t)
+ (put 'viper-vi-global-user-minor-mode 'permanent-local t)
+ (put 'viper-vi-state-modifier-minor-mode 'permanent-local t)
+ (put 'viper-vi-diehard-minor-mode 'permanent-local t)
+ (put 'viper-vi-kbd-minor-mode 'permanent-local t)
+ (put 'viper-insert-intercept-minor-mode 'permanent-local t)
+ (put 'viper-insert-basic-minor-mode 'permanent-local t)
+ (put 'viper-insert-local-user-minor-mode 'permanent-local t)
+ (put 'viper-insert-global-user-minor-mode 'permanent-local t)
+ (put 'viper-insert-state-modifier-minor-mode 'permanent-local t)
+ (put 'viper-insert-diehard-minor-mode 'permanent-local t)
+ (put 'viper-insert-kbd-minor-mode 'permanent-local t)
+ (put 'viper-replace-minor-mode 'permanent-local t)
+ (put 'viper-emacs-intercept-minor-mode 'permanent-local t)
+ (put 'viper-emacs-local-user-minor-mode 'permanent-local t)
+ (put 'viper-emacs-global-user-minor-mode 'permanent-local t)
+ (put 'viper-emacs-kbd-minor-mode 'permanent-local t)
+ (put 'viper-emacs-state-modifier-minor-mode 'permanent-local t)
+ (put 'viper-vi-minibuffer-minor-mode 'permanent-local t)
+ (put 'viper-insert-minibuffer-minor-mode 'permanent-local t)
+ (put 'viper-automatic-iso-accents 'permanent-local t)
+ (put 'viper-special-input-method 'permanent-local t)
+ (put 'viper-intermediate-command 'permanent-local t)
+ ;; already local: viper-undo-needs-adjustment
+ (put 'viper-began-as-replace 'permanent-local t)
+ ;; already local: viper-replace-overlay
+ ;; already local: viper-last-posn-in-replace-region
+ ;; already local: viper-last-posn-while-in-insert-state
+ ;; already local: viper-sitting-in-replace
+ (put 'viper-replace-chars-to-delete 'permanent-local t)
+ (put 'viper-replace-region-chars-deleted 'permanent-local t)
+ (put 'viper-current-state 'permanent-local t)
+ (put 'viper-cted 'permanent-local t)
+ (put 'viper-current-indent 'permanent-local t)
+ (put 'viper-preserve-indent 'permanent-local t)
+ (put 'viper-auto-indent 'permanent-local t)
+ (put 'viper-electric-mode 'permanent-local t)
+ ;; already local: viper-insert-point
+ ;; already local: viper-pre-command-point
+ (put 'viper-com-point 'permanent-local t)
+ (put 'viper-ex-style-motion 'permanent-local t)
+ (put 'viper-ex-style-editing 'permanent-local t)
+ (put 'viper-ESC-moves-cursor-back 'permanent-local t)
+ (put 'viper-delete-backwards-in-replace 'permanent-local t)
+ ;; already local: viper-related-files-and-buffers-ring
+ (put 'viper-local-search-start-marker 'permanent-local t)
+ (put 'viper-search-overlay 'permanent-local t)
+ (put 'viper-last-jump 'permanent-local t)
+ (put 'viper-last-jump-ignore 'permanent-local t)
+ (put 'viper-minibuffer-current-face 'permanent-local t)
+ ;; already local: viper-minibuffer-overlay
+ (put 'viper-command-ring 'permanent-local t)
+ (put 'viper-last-insertion 'permanent-local t)
+ ))
+(eval-after-load 'viper-keym
+ (progn
+ ;; already local: viper-vi-local-user-map
+ ;; already local: viper-insert-local-user-map
+ ;; already local: viper-emacs-local-user-map
+ (put 'viper--key-maps 'permanent-local t)
+ (put 'viper--intercept-key-maps 'permanent-local t)
+ ;; already local: viper-need-new-vi-local-map
+ ;; already local: viper-need-new-insert-local-map
+ ;; already local: viper-need-new-emacs-local-map
+ ))
+(eval-after-load 'viper-mous
+ (progn
+ (put 'viper-mouse-click-search-noerror 'permanent-local t)
+ (put 'viper-mouse-click-search-limit 'permanent-local t)
+ ))
+(eval-after-load 'viper-util
+ (progn
+ (put 'viper-syntax-preference 'permanent-local t)
+ (put 'viper-non-word-characters 'permanent-local t)
+ (put 'viper-ALPHA-char-class 'permanent-local t)
+ ))
+
+(eval-after-load 'cua-base
+ (progn
+ (put 'cua-inhibit-cua-keys 'permanent-local t)
+ (put 'cua--explicit-region-start 'permanent-local t)
+ (put 'cua--status-string 'permanent-local t)
+ ))
+;; This is for the defvar in ido.el:
+(eval-after-load 'ido
+ (progn
+ (put 'cua-inhibit-cua-keys 'permanent-local t)
+ ))
+(eval-after-load 'cua-rect
+ (progn
+ (put 'cua--rectangle 'permanent-local t)
+ (put 'cua--rectangle-overlays 'permanent-local t)
+ ))
+(eval-after-load 'edt
+ (progn
+ (put 'edt-select-mode 'permanent-local t)
+ ))
+(eval-after-load 'tpu-edt
+ (progn
+ (put 'tpu-newline-and-indent-p 'permanent-local t)
+ (put 'tpu-newline-and-indent-string 'permanent-local t)
+ (put 'tpu-saved-delete-func 'permanent-local t)
+ (put 'tpu-buffer-local-map 'permanent-local t)
+ (put 'tpu-mark-flag 'permanent-local t)
+ ))
+(eval-after-load 'vi
+ (progn
+ (put 'vi-add-to-mode-line 'permanent-local t)
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-scroll-amount
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-shift-width
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-point
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-length
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-repetition
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-overwrt-p
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-ins-prefix-code
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-last-change-command
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-last-shell-command
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-last-find-char
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mark-alist
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-insert-state
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mode-old-local-map
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mode-old-mode-name
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mode-old-major-mode
+ ;;Warning (mumamo-per-buffer-local-vars): Not a local variable: vi-mode-old-case-fold
+ ;;
+ ))
+(eval-after-load 'vi
+ (progn
+ (put 'vip-emacs-local-map 'permanent-local t)
+ (put 'vip-insert-local-map 'permanent-local t)
+ (put 'vip-insert-point 'permanent-local t)
+ (put 'vip-com-point 'permanent-local t)
+ (put 'vip-current-mode 'permanent-local t)
+ (put 'vip-emacs-mode-line-buffer-identification 'permanent-local t)
+ (put 'vip-current-major-mode 'permanent-local t)
+ ))
+
+(eval-after-load 'hi-lock
+ (progn
+ (put 'hi-lock-mode 'permanent-local t)
+ ))
+
+;;
+;; Minor modes that are not major mode specific
+;;
+
+(put 'visual-line-mode 'permanent-local t)
+
+(eval-after-load 'flymake
+ (progn
+ ;; hook functions:
+ (put 'flymake-after-change-function 'permanent-local-hook t)
+ (put 'flymake-after-save-hook 'permanent-local-hook t)
+ (put 'flymake-kill-buffer-hook 'permanent-local-hook t)
+ ;; hooks:
+;;; (put 'after-change-functions 'permanent-local 'permanent-local-hook)
+;;; (put 'after-save-hook 'permanent-local 'permanent-local-hook)
+;;; (put 'kill-buffer-hook 'permanent-local 'permanent-local-hook)
+ ;; vars:
+ (put 'flymake-mode 'permanent-local t)
+ (put 'flymake-is-running 'permanent-local t)
+ (put 'flymake-timer 'permanent-local t)
+ (put 'flymake-last-change-time 'permanent-local t)
+ (put 'flymake-check-start-time 'permanent-local t)
+ (put 'flymake-check-was-interrupted 'permanent-local t)
+ (put 'flymake-err-info 'permanent-local t)
+ (put 'flymake-new-err-info 'permanent-local t)
+ (put 'flymake-output-residual 'permanent-local t)
+ (put 'flymake-mode-line 'permanent-local t)
+ (put 'flymake-mode-line-e-w 'permanent-local t)
+ (put 'flymake-mode-line-status 'permanent-local t)
+ (put 'flymake-temp-source-file-name 'permanent-local t)
+ (put 'flymake-master-file-name 'permanent-local t)
+ (put 'flymake-temp-master-file-name 'permanent-local t)
+ (put 'flymake-base-dir 'permanent-local t)))
+
+;; (eval-after-load 'imenu
+;; (progn
+;; ;; Fix-me: imenu is only useful for main major mode. The menu
+;; ;; disappears in sub chunks because it is tighed to
+;; ;; local-map. Don't know what to do about that. I do not
+;; ;; understand the reason for binding it to local-map, but I
+;; ;; suspect the intent is to have different menu items for
+;; ;; different modes. Could not that be achieved by deleting the
+;; ;; menu and creating it again when changing major mode? (That must
+;; ;; be implemented in imenu.el of course.)
+;; ;;
+;; ;; hook functions:
+;; ;;; (put 'imenu-update-menubar 'permanent-local-hook t)
+;; ;; hooks:
+;; (put 'menu-bar-update-hook 'permanent-local 'permanent-local-hook)
+;; ;; vars:
+;; (put 'imenu-generic-expression 'permanent-local t)
+;; (put 'imenu-create-index-function 'permanent-local t)
+;; (put 'imenu-prev-index-position-function 'permanent-local t)
+;; (put 'imenu-extract-index-name-function 'permanent-local t)
+;; (put 'imenu-name-lookup-function 'permanent-local t)
+;; (put 'imenu-default-goto-function 'permanent-local t)
+;; (put 'imenu--index-alist 'permanent-local t)
+;; (put 'imenu--last-menubar-index-alist 'permanent-local t)
+;; (put 'imenu-syntax-alist 'permanent-local t)
+;; (put 'imenu-case-fold-search 'permanent-local t)
+;; (put 'imenu-menubar-modified-tick 'permanent-local t)
+;; ))
+
+(eval-after-load 'longlines
+ (progn
+ ;; Fix-me: take care of longlines-mode-off
+ (put 'longlines-mode 'permanent-local t)
+ (put 'longlines-wrap-beg 'permanent-local t)
+ (put 'longlines-wrap-end 'permanent-local t)
+ (put 'longlines-wrap-point 'permanent-local t)
+ (put 'longlines-showing 'permanent-local t)
+ (put 'longlines-decoded 'permanent-local t)
+ ;;
+ (put 'longlines-after-change-function 'permanent-local-hook t)
+ (put 'longlines-after-revert-hook 'permanent-local-hook t)
+ (put 'longlines-before-revert-hook 'permanent-local-hook t)
+ (put 'longlines-decode-buffer 'permanent-local-hook t)
+ (put 'longlines-decode-region 'permanent-local-hook t)
+ (put 'longlines-mode-off 'permanent-local-hook t)
+ (put 'longlines-post-command-function 'permanent-local-hook t)
+ (put 'longlines-window-change-function 'permanent-local-hook t)
+ ;;(put 'mail-indent-citation 'permanent-local-hook t)
+ ))
+
+
+;; Fix-me: Rails, many problematic things:
+
+;;; Fix-me: No idea about these, where are they used?? Add them to
+;;; mumamo-per-buffer-local-vars?:
+;; predictive-main-dict
+;; predictive-prog-mode-main-dict
+;; predictive-use-auto-learn-cache
+;; predictive-dict-autosave-on-kill-buffer
+(eval-after-load 'inf-ruby
+ (progn
+ (put 'inferior-ruby-first-prompt-pattern 'permanent-local t)
+ (put 'inferior-ruby-prompt-pattern 'permanent-local t)
+ ))
+
+;;; These are for the output buffer (no problems):
+;; font-lock-keywords-only
+;; font-lock-defaults -- always buffer local
+;; scroll-margin
+;; scroll-preserve-screen-position
+
+(eval-after-load 'rails-script
+ (progn
+ (put 'rails-script:run-after-stop-hook 'permanent-local t)
+ (put 'rails-script:show-buffer-hook 'permanent-local t)
+ (put 'rails-script:output-mode-ret-value 'permanent-local t)
+ ))
+
+;;; No problems I believe (it is in output buffer):
+;; compilation-error-regexp-alist-alist
+;; compilation-error-regexp-alist
+
+;;; Fix-me: This is in the minor mode, what to do? Looks like it
+;;; should have 'permanent-local t - in this case. I have added it to
+;;; mumamo-per-buffer-local-vars for now.
+;; tags-file-name
+
+(eval-after-load 'rails
+ (progn
+ (put 'rails-primary-switch-func 'permanent-local t)
+ (put 'rails-secondary-switch-func 'permanent-local t)
+ ))
+
+;; (defun test-js-perm ()
+;; (put 'js--quick-match-re 'permanent-local t)
+;; (put 'js--quick-match-re-func 'permanent-local t)
+;; (put 'js--cache-end 'permanent-local t)
+;; (put 'js--last-parse-pos 'permanent-local t)
+;; (put 'js--state-at-last-parse-pos 'permanent-local t)
+;; (put 'js--tmp-location 'permanent-local t))
+;; (test-js-perm)
+
+(defvar mumamo-per-buffer-local-vars
+ '(
+ buffer-file-name
+ left-margin-width
+ right-margin-width
+ ;; Fix-me: This is to prevent font-lock-mode turning off/on, but
+ ;; is it necessary?
+ ;;font-lock-mode-major-mode
+ tags-file-name
+ nxhtml-menu-mode
+ ;; Fix-me: adding rng timers here stops Emacs from looping after
+ ;; indenting in ind-0-error.php, but I have no clue why. Hm. This
+ ;; problem is gone, but I forgot why.
+ rng-c-current-token ;;rng-cmpct.el:132:(make-variable-buffer-local 'rng-c-current-token)
+ rng-c-escape-positions ;;rng-cmpct.el:341:(make-variable-buffer-local 'rng-c-escape-positions)
+ rng-c-file-name ;;rng-cmpct.el:344:(make-variable-buffer-local 'rng-c-file-name)
+ rng-current-schema-file-name ;;rng-loc.el:37:(make-variable-buffer-local 'rng-current-schema-file-name)
+ rng-current-schema ;;rng-pttrn.el:71:(make-variable-buffer-local 'rng-current-schema)
+ ;;rng-validate-timer is permanent-local t
+ ;;rng-validate-timer ;;rng-valid.el:141:(make-variable-buffer-local 'rng-validate-timer)
+ ;;rng-validate-quick-timer is permanent-local t
+ ;;rng-validate-quick-timer ;;rng-valid.el:146:(make-variable-buffer-local 'rng-validate-quick-timer)
+ rng-error-count ;;rng-valid.el:153:(make-variable-buffer-local 'rng-error-count)
+ rng-message-overlay ;;rng-valid.el:158:(make-variable-buffer-local 'rng-message-overlay)
+ rng-message-overlay-inhibit-point ;;rng-valid.el:165:(make-variable-buffer-local 'rng-message-overlay-inhibit-point)
+ rng-message-overlay-current ;;rng-valid.el:169:(make-variable-buffer-local 'rng-message-overlay-current)
+ rng-validate-up-to-date-end ;;rng-valid.el:188:(make-variable-buffer-local 'rng-validate-up-to-date-end)
+ rng-conditional-up-to-date-start ;;rng-valid.el:199:(make-variable-buffer-local 'rng-conditional-up-to-date-start)
+ rng-conditional-up-to-date-end ;;rng-valid.el:205:(make-variable-buffer-local 'rng-conditional-up-to-date-end)
+ rng-validate-mode ;;rng-valid.el:212:(make-variable-buffer-local 'rng-validate-mode)
+ rng-dtd ;;rng-valid.el:215:(make-variable-buffer-local 'rng-dtd)
+
+ nxml-syntax-highlight-flag ;; For pre-Emacs nxml
+ ;;nxml-ns-state - not buffer local currently
+ nxml-prolog-regions ;;snxml-mode.el:362:(make-variable-buffer-local 'nxml-prolog-regions)
+ nxml-last-fontify-end ;;dnxml-mode.el:367:(make-variable-buffer-local 'nxml-last-fontify-end)
+ nxml-degraded ;;dnxml-mode.el:373:(make-variable-buffer-local 'nxml-degraded)
+ nxml-char-ref-extra-display ;;ynxml-mode.el:397:(make-variable-buffer-local 'nxml-char-ref-extra-display)
+ nxml-prolog-end ;;dnxml-rap.el:92:(make-variable-buffer-local 'nxml-prolog-end)
+ nxml-scan-end ;;dnxml-rap.el:107:(make-variable-buffer-local 'nxml-scan-end)
+
+ ;;buffer-invisibility-spec
+ ;;header-line-format
+
+ ;; Fix-me: These must be handled with 'permanent-local since they may be changed:
+ line-move-visual ;;simple.el:4537: (kill-local-variable 'line-move-visual)
+ word-wrap ;;simple.el:4538: (kill-local-variable 'word-wrap)
+ truncate-lines ;;simple.el:4539: (kill-local-variable 'truncate-lines)
+ truncate-partial-width-windows ;;simple.el:4540: (kill-local-variable 'truncate-partial-width-windows)
+ fringe-indicator-alist ;;simple.el:4541: (kill-local-variable 'fringe-indicator-alist)
+ visual-line--saved-state ;;simple.el:4544: (kill-local-variable 'visual-line--saved-state)))
+ vis-mode-saved-buffer-invisibility-spec ;;simple.el:6237: (kill-local-variable 'vis-mode-saved-buffer-invisibility-spec))
+
+ )
+ "Per buffer local variables.
+See also `mumamo-per-main-major-local-vars'.")
+
+;; Fix-me: use this, but how exactly? I think the var values must be
+;; picked up at every change from main major mode. And restored after
+;; changing to the new major mode - but maybe a bit differently if
+;; this is the main major mode.
+(defvar mumamo-per-main-major-local-vars
+ '(
+ buffer-invisibility-spec
+ header-line-format
+ )
+ "Per main major local variables.
+Like `mumamo-per-buffer-local-vars', but this is fetched from the
+main major mode.")
+
+;; (when nil
+;; (make-variable-buffer-local 'mumamo-survive-minor-modes)
+;; (put 'mumamo-survive-minor-modes 'permanent-local t)
+;; (defvar mumamo-survive-minor-modes nil
+;; "Hold local minor mode variables specific major modes.
+;; Those values are saved when leaving a chunk with a certain
+;; major mode and restored when entering a chunk with the same
+;; major mode again.
+
+;; The value of this variable is an associative list where the key
+;; is a list with
+
+;; \(MAJOR-MODE MINOR-MODE)
+
+;; and the value is a stored value for the minor mode.")
+;; )
+
+(defun mumamo-make-variable-buffer-permanent (var)
+ "Make buffer local value of VAR survive when moving point to a new chunk.
+When point is moved between chunks in a multi major mode the
+major mode will be changed. This will by default kill all local
+variables unless they have a non-nil `permanent-local' property
+\(see info node `(elisp)Creating Buffer-Local').
+
+If you do not want to put a `permanent-local' property on a
+variable you can instead use this function to make variable VAR
+survive chunk switches in all mumamo multi major mode buffers."
+ ;; If you want it to survive chunk switches only in the current
+ ;; buffer then use `mumamo-make-local-permanent' instead."
+ (pushnew var (default-value 'mumamo-per-buffer-local-vars)))
+
+;; ;; Fix-me: use local value
+;; ;; Fix-me: delelete local value when exiting mumamo
+;; (defun mumamo-make-local-permanent (var)
+;; "Make buffer local value of VAR survive when moving point to a new chunk.
+;; This is for the current buffer only.
+;; In most cases you almost certainly want to use
+;; `mumamo-make-variable-buffer-permanent' instead."
+;; (pushnew var mumamo-per-buffer-local-vars))
+
+(defvar mumamo-per-buffer-local-vars-done-by-me nil
+ "Variables set by mumamo already.
+Used to avoid unnecessary warnings if setting major mode fails.")
+
+;; (mumamo-hook-p 'viper-pre-command-hooks)
+;; (mumamo-hook-p 'viper-before-change-functions)
+;; (mumamo-hook-p 'c-special-indent-hook)
+(defun mumamo-hook-p (sym)
+ "Try to detect if SYM is a hook variable.
+Just check the name."
+ (let ((name (symbol-name sym)))
+ (or (string= "-hook" (substring name -5))
+ (string= "-hooks" (substring name -6))
+ (string= "-functions" (substring name -10)))))
+
+(defvar mumamo-major-mode nil)
+(make-variable-buffer-local 'mumamo-major-mode)
+(put 'mumamo-major-mode 'permanent-local t)
+
+(defvar mumamo-change-major-mode-no-nos
+ '((font-lock-change-mode t)
+ (longlines-mode-off t)
+ global-font-lock-mode-cmhh
+ (nxml-cleanup t)
+ (turn-off-hideshow t))
+ "Avoid running these in `change-major-mode-hook'.")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Remove things from hooks temporarily
+
+;; Fix-me: This is a bit disorganized, could not decide which level I
+;; wanted this on.
+
+(defvar mumamo-after-change-major-mode-no-nos
+ '(;;nxhtml-global-minor-mode-enable-in-buffers
+ global-font-lock-mode-enable-in-buffers)
+ "Avoid running these in `after-change-major-mode-hook'.")
+
+(defvar mumamo-removed-from-hook nil)
+
+(defun mumamo-remove-from-hook (hook remove)
+ "From hook HOOK remove functions in list REMOVE.
+Save HOOK and the list of functions removed to
+`mumamo-removed-from-hook'."
+ (let (did-remove
+ removed)
+ (dolist (rem remove)
+ ;;(message "rem.rem=%s" rem)
+ (setq did-remove nil)
+ (if (listp rem)
+ (when (memq (car rem) (symbol-value hook))
+ (setq did-remove t)
+ (remove-hook hook (car rem) t))
+ (when (memq rem (symbol-value hook))
+ (setq did-remove t)
+ (remove-hook hook rem)))
+ (when did-remove
+ (setq removed (cons rem removed))))
+ (setq mumamo-removed-from-hook
+ (cons (cons hook removed)
+ mumamo-removed-from-hook))))
+
+(defun mumamo-addback-to-hooks ()
+ "Add back what was removed by `mumamo-remove-from-hook'."
+ ;;(message "mumamo-removed-from-hook=%s" mumamo-removed-from-hook)
+ (dolist (rem-rec mumamo-removed-from-hook)
+ (mumamo-addback-to-hook (car rem-rec) (cdr rem-rec))))
+
+(defun mumamo-addback-to-hook (hook removed)
+ "Add to hook HOOK the list of functions in REMOVED."
+ ;;(message "addback: hook=%s, removed=%s" hook removed)
+ (dolist (rem removed)
+ ;;(message "add.rem=%s" rem)
+ (if (listp rem)
+ (add-hook hook (car rem) nil t)
+ (add-hook hook rem))))
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Compare mumamo-irrelevant-buffer-local-vars
+(defvar mumamo-buffer-locals-dont-set
+ '(
+ adaptive-fill-mode
+ adaptive-fill-first-line-regexp
+ adaptive-fill-regexp
+ add-log-current-defun-header-regexp
+ auto-composition-function
+ auto-composition-mode
+ auto-composition-mode-major-mode
+ auto-fill-chars
+
+ beginning-of-defun-function
+ buffer-auto-save-file-format
+ buffer-auto-save-file-name
+ buffer-backed-up
+ buffer-display-count
+ buffer-display-time
+ buffer-file-coding-system
+ buffer-file-format
+ buffer-file-name
+ buffer-file-truename
+ buffer-invisibility-spec
+ buffer-read-only
+ buffer-saved-size
+ buffer-undo-list
+
+ c++-template-syntax-table
+ c-<-op-cont-regexp
+ c-<>-multichar-token-regexp
+ c->-op-cont-regexp
+ c-after-suffixed-type-decl-key
+ c-after-suffixed-type-maybe-decl-key
+ c-anchored-cpp-prefix
+ c-assignment-op-regexp
+ c-at-vsemi-p-fn
+ c-backslash-column
+ c-backslash-max-column
+ ;;c-basic-offset
+ c-before-font-lock-function
+ c-block-comment-prefix
+ c-block-comment-start-regexp
+ c-block-prefix-charset
+ c-block-stmt-1-key
+ c-block-stmt-2-key
+ c-brace-list-key
+ c-cast-parens
+ c-class-key
+ c-cleanup-list
+ c-colon-type-list-re
+ c-comment-only-line-offset
+ c-comment-prefix-regexp
+ c-comment-start-regexp
+ c-current-comment-prefix
+ c-decl-block-key
+ c-decl-hangon-key
+ c-decl-prefix-or-start-re
+ c-decl-prefix-re
+ c-decl-start-re
+ c-doc-comment-start-regexp
+ c-doc-comment-style
+ c-found-types
+ c-get-state-before-change-function
+ c-hanging-braces-alist
+ c-hanging-colons-alist
+ c-hanging-semi&comma-criteria
+ c-identifier-key
+ c-identifier-start
+ c-identifier-syntax-modifications
+ c-identifier-syntax-table
+ ;;c-indent-comment-alist
+ ;;c-indent-comments-syntactically-p
+ ;;c-indentation-style
+ c-keywords-obarray
+ c-keywords-regexp
+ c-known-type-key
+ c-label-kwds-regexp
+ c-label-minimum-indentation
+ c-label-prefix-re
+ c-line-comment-starter
+ c-literal-start-regexp
+ c-multiline-string-start-char
+ c-nonlabel-token-key
+ c-nonsymbol-chars
+ c-nonsymbol-token-regexp
+ c-not-decl-init-keywords
+ ;;c-offsets-alist
+ c-old-BOM
+ c-old-EOM
+ c-opt-<>-arglist-start
+ c-opt-<>-arglist-start-in-paren
+ c-opt-<>-sexp-key
+ c-opt-asm-stmt-key
+ c-opt-bitfield-key
+ c-opt-block-decls-with-vars-key
+ c-opt-block-stmt-key
+ c-opt-cpp-macro-define-id
+ c-opt-cpp-macro-define-start
+ c-opt-cpp-prefix
+ c-opt-cpp-start
+ c-opt-extra-label-key
+ c-opt-friend-key
+ c-opt-identifier-concat-key
+ c-opt-inexpr-brace-list-key
+ c-opt-method-key
+ c-opt-op-identifier-prefix
+ c-opt-postfix-decl-spec-key
+ c-opt-type-component-key
+ c-opt-type-concat-key
+ c-opt-type-modifier-key
+ c-opt-type-suffix-key
+ c-other-decl-block-key
+ c-other-decl-block-key-in-symbols-alist
+ c-overloadable-operators-regexp
+ c-paragraph-separate
+ c-paragraph-start
+ c-paren-stmt-key
+ c-prefix-spec-kwds-re
+ c-primary-expr-regexp
+ c-primitive-type-key
+ c-recognize-<>-arglists
+ c-recognize-colon-labels
+ c-recognize-knr-p
+ c-recognize-paren-inexpr-blocks
+ c-recognize-paren-inits
+ c-recognize-typeless-decls
+ c-regular-keywords-regexp
+ c-simple-stmt-key
+ c-special-brace-lists
+ c-special-indent-hook
+ c-specifier-key
+ c-stmt-delim-chars
+ c-stmt-delim-chars-with-comma
+ c-string-escaped-newlines
+ c-symbol-key
+ c-symbol-start
+ c-syntactic-eol
+ c-syntactic-ws-end
+ c-syntactic-ws-start
+ c-type-decl-end-used
+ c-type-decl-prefix-key
+ c-type-decl-suffix-key
+ c-type-prefix-key
+ c-vsemi-status-unknown-p-fn
+
+ case-fold-search
+ comment-end
+ comment-end-skip
+ comment-indent-function
+ comment-line-break-function
+ comment-multi-line
+ comment-start
+ comment-start-skip
+ cursor-type
+
+ default-directory
+ defun-prompt-regexp
+ delay-mode-hooks
+
+ enable-multibyte-characters
+ end-of-defun-function
+
+ fill-paragraph-function
+ font-lock-beginning-of-syntax-function
+ font-lock-defaults
+ font-lock-extend-after-change-region-function
+ font-lock-extend-region-functions
+ font-lock-fontified
+ font-lock-fontify-buffer-function
+ font-lock-fontify-region-function
+ font-lock-keywords
+ ;;font-lock-keywords-only
+ font-lock-keywords-case-fold-search
+ font-lock-mode
+ font-lock-mode-hook
+ font-lock-mode-major-mode
+ font-lock-multiline
+ font-lock-set-defaults
+ font-lock-syntactic-keywords
+ font-lock-syntactically-fontified
+ font-lock-syntax-table
+ font-lock-unfontify-buffer-function
+ font-lock-unfontify-region-function
+ fontification-functions
+ forward-sexp-function
+
+ indent-line-function
+ indent-region-function
+ imenu--index-alist
+ imenu--last-menubar-index-alist
+ imenu-create-index-function
+ imenu-menubar-modified-tick
+ isearch-mode
+
+ jit-lock-after-change-extend-region-functions
+ jit-lock-context-unfontify-pos
+ jit-lock-contextually
+ jit-lock-functions
+ jit-lock-mode
+
+ line-move-ignore-invisible
+ local-abbrev-table
+
+ major-mode
+ mark-active
+ ;;mark-ring
+ mode-line-process
+ mode-name
+
+ normal-auto-fill-function
+ ;;nxhtml-menu-mode-major-mode
+
+ open-paren-in-column-0-is-defun-start
+ outline-level
+ outline-regexp
+
+ paragraph-ignore-fill-prefix
+ paragraph-separate
+ paragraph-start
+ parse-sexp-ignore-comments
+ parse-sexp-lookup-properties
+ php-mode-pear-hook
+ point-before-scroll
+
+ ;; More symbols from visual inspection
+ ;;before-change-functions
+ ;;delayed-mode-hooks
+ ;;imenu-case-fold-search
+ ;;imenu-generic-expression
+ rngalt-completing-read-tag
+ rngalt-completing-read-attribute-name
+ rngalt-completing-read-attribute-value
+ rngalt-complete-first-try
+ rngalt-complete-last-try
+ rngalt-complete-tag-hooks
+
+ syntax-begin-function
+ )
+ "Buffer local variables that is not saved/set per chunk.
+This is supposed to contain mostly buffer local variables
+specific to major modes and that are not meant to be customized
+by the user.
+")
+
+(when (< emacs-major-version 23)
+ (defadvice c-after-change (around
+ mumamo-ad-c-after-change
+ activate
+ compile
+ )
+ ;;(msgtrc "c-after-change: major-mode=%s c-nonsymbol-token-regexp=%s" major-mode c-nonsymbol-token-regexp)
+ (when (or (not mumamo-multi-major-mode)
+ (derived-mode-p 'c-mode))
+ ad-do-it))
+ )
+
+(defun mumamo-save-per-major-local-vars (major)
+ "Save some per major local variables for major mode MAJOR.
+This should be called before switching to a new chunks major
+mode."
+ ;;(message "mumamo-save-per-major-local-vars %s %s" major (current-buffer))
+ (let ((locals (buffer-local-variables)))
+ (setq locals (mapcar (lambda (local)
+ (unless
+ (or (memq (car local) mumamo-buffer-locals-dont-set)
+ (memq (car local) mumamo-per-buffer-local-vars)
+ (memq (car local) mumamo-per-main-major-local-vars)
+ (get (car local) 'permanent-local))
+ local))
+ locals))
+ (setq locals (delq nil locals))
+ (setq locals (sort locals (lambda (sym-a sym-b)
+ (string< (symbol-name (car sym-a))
+ (symbol-name (car sym-b))))))
+ (setq mumamo-buffer-locals-per-major
+ (assq-delete-all major mumamo-buffer-locals-per-major))
+ (setq mumamo-buffer-locals-per-major
+ (cons (cons major-mode locals)
+ mumamo-buffer-locals-per-major))))
+
+;; (benchmark 1000 '(mumamo-save-per-major-local-vars major-mode))
+;; (benchmark 1000 '(mumamo-restore-per-major-local-vars major-mode))
+(defvar mumamo-restore-per-major-local-vars-in-hook-major nil)
+(defun mumamo-restore-per-major-local-vars-in-hook ()
+ "Restore some per major mode local variables.
+Call `mumamo-restore-per-major-local-vars'.
+Use `mumamo-restore-per-major-local-vars-in-hook-major' as the
+major mode.
+
+This should be called in the major mode setup hook."
+ (mumamo-restore-per-major-local-vars
+ mumamo-restore-per-major-local-vars-in-hook-major)
+ (setq mumamo-restore-per-major-local-vars-in-hook-major nil))
+(put 'mumamo-restore-per-major-local-vars-in-hook 'permanent-local-hook t)
+
+(defun mumamo-restore-per-major-local-vars (major)
+ "Restore some per major local variables for major mode MAJOR.
+This should be called after switching to a new chunks major
+mode."
+ (let ((locals (cdr (assq major mumamo-buffer-locals-per-major)))
+ var
+ perm)
+ (dolist (rec locals)
+ (setq var (car rec))
+ (setq perm (get var 'permanent-local))
+ (unless (or perm
+ (memq var mumamo-buffer-locals-dont-set))
+ (set (make-local-variable var) (cdr rec))))))
+
+;; (defun mumamo-testing-new ()
+;; (let ((locals (buffer-local-variables))
+;; var
+;; perm
+;; )
+;; (dolist (rec locals)
+;; (setq var (car rec))
+;; (setq perm (get var 'permanent-local))
+;; (unless (or perm
+;; (memq var mumamo-buffer-locals-dont-set))
+;; (setq var (cdr rec))))
+;; ))
+;; ;;(benchmark 1000 '(mumamo-testing-new))
+
+(defun mumamo-get-hook-value (hook remove)
+ "Return hook HOOK value with entries in REMOVE removed.
+Remove also t. The value returned is a list of both local and
+default values."
+ (let ((value (append (symbol-value hook) (default-value hook) nil)))
+ (dolist (rem remove)
+ (setq value (delq rem value)))
+ (delq t value)))
+
+;; FIX-ME: Clean up the different ways of surviving variables during
+;; change of major mode.
+(defvar mumamo-set-major-keymap-checked nil)
+(make-variable-buffer-local 'mumamo-set-major-keymap-checked)
+
+(defvar mumamo-org-startup-done nil)
+(make-variable-buffer-local 'mumamo-org-startup-done)
+(put 'mumamo-org-startup-done 'permanent-local t)
+
+
+(defun mumamo-font-lock-fontify-chunk ()
+ "Like `font-lock-default-fontify-buffer' but for a chunk.
+Buffer must be narrowed to inner part of chunk when this function
+is called."
+ (let ((verbose (if (numberp font-lock-verbose)
+ (and (> font-lock-verbose 0)
+ (> (- (point-max) (point-min)) font-lock-verbose))
+ font-lock-verbose))
+ font-lock-extend-region-functions ;; accept narrowing
+ (font-lock-unfontify-region-function 'ignore))
+ ;;(setq verbose t)
+ (with-temp-message
+ (when verbose
+ (format "Fontifying %s part %s-%s (%s)..." (buffer-name) (point-min) (point-max) font-lock-verbose))
+ (condition-case err
+ (save-excursion
+ (save-match-data
+ (font-lock-fontify-region (point-min) (point-max) verbose)
+ (font-lock-after-fontify-buffer)
+ (setq font-lock-fontified t)))
+ (msgtrc "font-lock-fontify-chunk: %s" (error-message-string err))
+ ;; We don't restore the old fontification, so it's best to unfontify.
+ (quit (mumamo-font-lock-unfontify-chunk))))))
+
+
+(defun mumamo-font-lock-unfontify-chunk ()
+ "Like `font-lock-default-unfontify-buffer' for .
+Buffer must be narrowed to chunk when this function is called."
+ ;; Make sure we unfontify etc. in the whole buffer.
+ (save-restriction
+ ;;(widen)
+ (font-lock-unfontify-region (point-min) (point-max))
+ (font-lock-after-unfontify-buffer)
+ (setq font-lock-fontified nil)))
+
+(defun mumamo-set-major (major chunk)
+ "Set major mode to MAJOR for mumamo."
+ (mumamo-msgfntfy "mumamo-set-major %s, %s" major (current-buffer))
+ (mumamo-cancel-idle-set-major-mode)
+ (remove-hook 'pre-command-hook 'mumamo-set-major-pre-command t)
+ ;;(mumamo-backtrace "mumamo-set-major")
+ (remove-hook 'text-mode-hook 'viper-mode) ;; Fix-me: maybe add it back...
+ (let ((start-time (get-internal-run-time))
+ end-time
+ used-time
+ ;; Viper
+ viper-vi-state-mode-list
+ viper-emacs-state-mode-list
+ viper-insert-state-mode-list
+ ;; Org-Mode
+ (org-inhibit-startup mumamo-org-startup-done)
+ ;; Tell `mumamo-change-major-function':
+ (mumamo-set-major-running major)
+ ;; Fix-me: Take care of the new values added to these hooks!
+ ;; That looks difficult. We may after this have changes to
+ ;; both buffer local value and global value. The global
+ ;; changes are in this variable, but the buffer local values
+ ;; have been set once again.
+ (change-major-mode-hook (mumamo-get-hook-value
+ 'change-major-mode-hook
+ mumamo-change-major-mode-no-nos))
+ (after-change-major-mode-hook (mumamo-get-hook-value
+ 'after-change-major-mode-hook
+ mumamo-after-change-major-mode-no-nos))
+ ;; Some major modes deactivates the mark, we do not want that:
+ deactivate-mark
+ ;; Font lock
+ (font-lock-mode font-lock-mode)
+ ;; We have to save and reset the cursor type, at least when
+ ;; Viper is used
+ (old-cursor-type cursor-type)
+ ;; Protect last-command: fix-me: probably remove
+ (last-command last-command)
+ ;; Fix-me: remove this
+ (old-rng-schema-file (when (boundp 'rng-current-schema-file-name) rng-current-schema-file-name))
+ ;; Local vars, per buffer and per major mode
+ per-buffer-local-vars-state
+ per-main-major-local-vars-state
+ )
+ ;; We are not changing mode from font-lock's point of view, so do
+ ;; not tell font-lock (let binding these hooks is probably not a
+ ;; good choice since they may contain other stuff too):
+ (setq mumamo-removed-from-hook nil)
+ (mumamo-remove-from-hook 'change-major-mode-hook mumamo-change-major-mode-no-nos)
+
+ ;;;;;;;;;;;;;;;;
+ ;; Save per buffer local variables
+ (dolist (sym (reverse mumamo-per-buffer-local-vars))
+ (when (boundp sym)
+ (when (and (get sym 'permanent-local)
+ (not (memq sym mumamo-per-buffer-local-vars-done-by-me))
+ (not (mumamo-hook-p sym)))
+ (delq sym mumamo-per-buffer-local-vars)
+ (lwarn 'mumamo-per-buffer-local-vars :warning
+ "Already 'permanent-local t: %s" sym))))
+ (dolist (var mumamo-per-buffer-local-vars)
+ (if (local-variable-p var)
+ (push (cons var (symbol-value var))
+ per-buffer-local-vars-state)))
+
+ ;;;;;;;;;;;;;;;;
+ ;; Save per main major local variables
+ (when (mumamo-fun-eq major-mode (mumamo-main-major-mode))
+ (dolist (var mumamo-per-main-major-local-vars)
+ (if (local-variable-p var)
+ (push (cons var (symbol-value var))
+ per-main-major-local-vars-state))))
+
+ ;; For all hooks that probably can have buffer local values, go
+ ;; through the buffer local values and look for a permanent-local
+ ;; property on each function. Remove those functions that does not
+ ;; have it. Then make the buffer local value of the hook survive
+ ;; by putting a permanent-local property on it.
+ (unless (> emacs-major-version 22)
+ (dolist (hk mumamo-survive-hooks)
+ (put hk 'permanent-local t)
+ (when (local-variable-p hk)
+ (let ((hkv (copy-sequence (symbol-value hk))))
+ (dolist (v hkv)
+ (unless (or (eq v t)
+ (get v 'permanent-local-hook))
+ (remove-hook hk v t)
+ ))))))
+
+ (run-hooks 'mumamo-change-major-mode-hook)
+
+ (setq mumamo-major-mode major)
+
+ ;;;;;;;;;;;;;;;;
+ ;; Save per major mode local variables before switching major
+ (mumamo-save-per-major-local-vars major-mode)
+ ;; Prepare to restore per major mode local variables after
+ ;; switching back to major-mode, but do it in the greatest
+ ;; ancestor's mode hook (see `run-mode-hooks'):
+ (let (ancestor-hook-sym
+ parent-hook-sym
+ (parent major))
+ ;; We want the greatest ancestor's mode hook:
+ (setq parent-hook-sym (intern-soft (concat (symbol-name parent) "-hook")))
+ (when parent-hook-sym (setq ancestor-hook-sym parent-hook-sym))
+ (while (get parent 'derived-mode-parent)
+ (setq parent (get parent 'derived-mode-parent))
+ (setq parent-hook-sym (intern-soft (concat (symbol-name parent) "-hook")))
+ (when parent-hook-sym (setq ancestor-hook-sym parent-hook-sym)))
+ (when ancestor-hook-sym
+ ;; Put first in local hook to run it first:
+ (setq mumamo-restore-per-major-local-vars-in-hook-major major)
+ (add-hook ancestor-hook-sym
+ 'mumamo-restore-per-major-local-vars-in-hook
+ nil t))
+
+ ;;(msgtrc "set-major A: buffer-invisibility-spec=%S" buffer-invisibility-spec)
+ ;;(msgtrc "set-major A: word-wrap=%S, cb=%s" word-wrap (current-buffer))
+ ;;(mumamo-backtrace "set-major")
+ (let ((here (point)))
+ (unwind-protect
+ (save-restriction
+ (let* ((minmax (mumamo-chunk-syntax-min-max chunk t))
+ (min (car minmax))
+ (max (cdr minmax))
+ (here (point))
+ ;; Fix-me: For some reason let binding did not help. Is this a bug or?
+ ;;
+ ;;(font-lock-fontify-buffer-function 'mumamo-font-lock-fontify-chunk)
+ (old-bf (buffer-local-value 'font-lock-fontify-buffer-function (current-buffer)))
+ (inhibit-redisplay t) ;; Fix-me: said to be for internal purposes only
+ )
+ (narrow-to-region min max)
+ (set (make-local-variable 'font-lock-fontify-buffer-function) 'mumamo-font-lock-fontify-chunk)
+ ;;(message "funcall major=%s, %s" major font-lock-fontify-buffer-function)
+ ;;(message "before funcall: function=%s" font-lock-fontify-buffer-function)
+ (put 'font-lock-fontify-buffer-function 'permanent-local t)
+ (funcall major) ;; <-----------------------------------------------
+ (put 'font-lock-fontify-buffer-function 'permanent-local nil)
+ (when old-bf
+ (set (make-local-variable 'font-lock-fontify-buffer-function) old-bf))
+ ))
+ (goto-char here)))
+ ;;(msgtrc "set-major B: buffer-invisibility-spec=%S" buffer-invisibility-spec)
+ ;;(msgtrc "set-major B: word-wrap=%S, cb=%s" word-wrap (current-buffer))
+
+ (setq font-lock-mode-major-mode major) ;; Tell font-lock it is ok
+ (set (make-local-variable 'font-lock-function) 'mumamo-font-lock-function)
+ (if (not ancestor-hook-sym)
+ (mumamo-restore-per-major-local-vars major)
+ (remove-hook ancestor-hook-sym
+ 'mumamo-restore-per-major-local-vars-in-hook
+ t)))
+ ;;(msgtrc "set-major c: buffer-invisibility-spec=%S" buffer-invisibility-spec)
+
+ (when (mumamo-fun-eq major 'org-mode) (setq mumamo-org-startup-done t))
+
+ (setq mumamo-major-mode-indent-line-function (cons major-mode indent-line-function))
+ (make-local-variable 'indent-line-function)
+
+ (setq mode-name (concat (format-mode-line mode-name)
+ (save-match-data
+ (replace-regexp-in-string
+ "-mumamo-mode$" ""
+ (format "/%s" mumamo-multi-major-mode)))))
+
+ (dolist (hk mumamo-survive-hooks) (put hk 'permanent-local nil))
+
+ ;; (when (and (featurep 'flymake)
+ ;; flymake-mode)
+ ;; (add-hook 'after-change-functions 'flymake-after-change-function nil t)
+ ;; (add-hook 'after-save-hook 'flymake-after-save-hook nil t)
+ ;; (add-hook 'kill-buffer-hook 'flymake-kill-buffer-hook nil t))
+
+ ;;;;;;;;;;;;;;;;
+ ;; Restore per buffer local variables
+
+ ;; (dolist (sym mumamo-per-buffer-local-vars)
+ ;; (when (boundp sym)
+ ;; (put sym 'permanent-local nil)))
+ ;;(msgtrc "per-buffer-local-vars-state=%S" per-buffer-local-vars-state)
+ (dolist (saved per-buffer-local-vars-state)
+ ;;(msgtrc "restore p buffer: %s, local=%s" (car saved) (local-variable-p (car saved)))
+ (unless (local-variable-p (car saved))
+ (set (make-local-variable (car saved)) (cdr saved))))
+
+ ;;;;;;;;;;;;;;;;
+ ;; Restore per main major local variables
+ (unless (mumamo-fun-eq major-mode (mumamo-main-major-mode))
+ (dolist (saved per-main-major-local-vars-state)
+ (set (make-local-variable (car saved)) (cdr saved))))
+
+ (mumamo-addback-to-hooks)
+
+ (setq cursor-type old-cursor-type)
+ (run-hooks 'mumamo-after-change-major-mode-hook)
+
+ (when (derived-mode-p 'nxml-mode)
+ (when (and old-rng-schema-file
+ (not (string= old-rng-schema-file rng-current-schema-file-name)))
+ (let ((rng-schema-change-hook nil)) ;(list 'rng-alidate-clear)))
+ (condition-case err
+ (progn
+ (rng-set-schema-file-1 old-rng-schema-file)
+ (rng-what-schema))
+ (nxml-file-parse-error
+ (nxml-display-file-parse-error err)))
+ (when rng-validate-mode
+ ;; Fix-me: Change rng-validate variables so that this is
+ ;; not necessary any more.
+ (rng-validate-mode 0)
+ (rng-validate-mode 1))
+ )))
+ ;; The nxml-parser should not die:
+ (when (mumamo-derived-from-mode (mumamo-main-major-mode) 'nxml-mode)
+ (add-hook 'after-change-functions 'rng-after-change-function nil t)
+ (add-hook 'after-change-functions 'nxml-after-change nil t)
+ ;; Added these for Emacs 22:
+ (unless nxml-prolog-end (setq nxml-prolog-end 1))
+ (unless nxml-scan-end (setq nxml-scan-end (copy-marker 1))))
+
+;;; (when (and global-font-lock-mode
+;;; font-lock-global-modes
+;;; font-lock-mode)
+;;; (when global-font-lock-mode
+;;; (add-hook 'change-major-mode-hook 'global-font-lock-mode-cmhh))
+;;; (add-hook 'change-major-mode-hook 'font-lock-change-mode nil t)
+
+ (mumamo-set-fontification-functions)
+
+ ;; If user has used M-x flyspell-mode then we need to correct it:
+ ;; Fix-me: This is inflexible. Need flyspell to cooperate.
+ (when (featurep 'flyspell)
+ (setq flyspell-generic-check-word-predicate 'mumamo-flyspell-verify))
+
+ (if mumamo-done-first-set-major
+ (setq mumamo-just-changed-major t)
+ (mumamo-msgfntfy "mumamo-set-major: ----- removing 'fontified")
+ ;; Set up to fontify buffer
+ (mumamo-save-buffer-state nil
+ (remove-list-of-text-properties (point-min) (point-max) '(fontified)))
+ (setq mumamo-done-first-set-major t))
+
+ ;; Timing, on a 3ghz cpu:
+ ;;
+ ;; used-time=(0 0 0), major-mode=css-mode
+ ;; used-time=(0 0 0), major-mode=ecmascript-mode
+ ;; used-time=(0 0 0), major-mode=html-mode
+ ;; used-time=(0 0 203000), major-mode=nxhtml-mode
+ ;;
+ ;; After some changes 2007-04-25:
+ ;;
+ ;; used-time=(0 0 15000), major-mode=nxhtml-mode
+ ;;
+ ;; which is 15 ms. That seems acceptable though I am not sure
+ ;; everything is correct when switching to nxhtml-mode yet. I
+ ;; will have to wait for bug reports ;-)
+ ;;
+ ;; The delay is clearly noticeable and disturbing IMO unless you
+ ;; change major mode in an idle timer.
+ ;;
+ ;;(setq end-time (get-internal-run-time))
+ ;;(setq used-time (time-subtract end-time start-time))
+ )
+ (setq mumamo-set-major-keymap-checked nil)
+ ;; Fix-me: Seems like setting/checking the keymap in a timer is
+ ;; problematc. This is an Emacs bug.
+ ;;(run-with-idle-timer 1 nil 'mumamo-set-major-check-keymap)
+ ;;(force-mode-line-update) (message "force-mode-line-update called")
+ )
+
+(defun mumamo-set-major-check-keymap ()
+ "Helper to work around an Emacs bug when setting local map in a timer."
+ (or mumamo-set-major-keymap-checked
+ (setq mumamo-set-major-keymap-checked
+ (let ((map-sym (intern-soft (concat (symbol-name major-mode) "-map"))))
+ (if (not map-sym)
+ t ;; Don't know what to do
+ (equal (current-local-map)
+ (symbol-value map-sym)))))))
+
+(defvar mumamo-original-fill-paragraph-function nil)
+(make-variable-buffer-local 'mumamo-original-fill-paragraph-function)
+
+(defun mumamo-setup-local-fontification-vars ()
+ "Set up buffer local variables for mumamo style fontification."
+ (make-local-variable 'font-lock-fontify-region-function)
+ (setq font-lock-fontify-region-function 'mumamo-fontify-region)
+
+ ;; Like font-lock-turn-on-thing-lock:
+ (make-local-variable 'font-lock-fontify-buffer-function)
+ (setq font-lock-fontify-buffer-function 'jit-lock-refontify)
+ (setq font-lock-fontify-buffer-function 'mumamo-fontify-buffer)
+ ;; Don't fontify eagerly (and don't abort if the buffer is large).
+ (set (make-local-variable 'font-lock-fontified) t)
+
+ (make-local-variable 'font-lock-unfontify-buffer-function)
+ (setq font-lock-unfontify-buffer-function 'mumamo-unfontify-buffer)
+
+ (set (make-local-variable 'indent-line-function) 'mumamo-indent-line-function)
+
+ ;;(setq mumamo-original-fill-paragraph-function fill-paragraph-function)
+ ;;(set (make-local-variable 'fill-paragraph-function) 'mumamo-fill-paragraph-function)
+ ;;(set (make-local-variable 'fill-forward-paragraph-function 'forward-paragraph)
+
+ (make-local-variable 'indent-region-function)
+ (setq indent-region-function 'mumamo-indent-region-function)
+
+ ;;(set (make-local-variable 'syntax-begin-function) 'mumamo-beginning-of-syntax)
+
+ ;;(put 'font-lock-function 'permanent-local t)
+
+ ;; FIX-ME: Not sure about this one, but it looks like it must be
+ ;; set:
+ (make-local-variable 'jit-lock-contextually)
+ (setq jit-lock-contextually t)
+ )
+
+(defun mumamo-font-lock-function (mode)
+ ;;(mumamo-backtrace "font-lock-function")
+ (font-lock-default-function mode))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Turning on/off multi major modes
+
+(defun mumamo-set-fontification-functions ()
+ "Let mumamo take over fontification.
+This is run after changing major mode so that jit-lock will get
+the major mode specific values. \(There are currently no such
+values.)"
+ ;; Give the jit machinery a starting point:
+ (mumamo-jit-lock-register 'font-lock-fontify-region t)
+ ;; Set the functions that font-lock should use:
+ (mumamo-setup-local-fontification-vars)
+ ;; Need some hook modifications to keep things together too:
+ (add-hook 'change-major-mode-hook 'mumamo-change-major-function nil t)
+ (add-hook 'post-command-hook 'mumamo-post-command nil t)
+ (remove-hook 'change-major-mode-hook 'nxml-change-mode t)
+ (remove-hook 'change-major-mode-hook 'nxhtml-change-mode t)
+ )
+
+(defun mumamo-initialize-state ()
+ "Initialize some mumamo state variables."
+ (setq mumamo-done-first-set-major nil)
+ (setq mumamo-just-changed-major nil))
+
+(defun mumamo-turn-on-actions (old-major-mode)
+ "Do what is necessary to turn on mumamo.
+Turn on minor mode function `font-lock-mode'.
+Set up for mumamo style fontification.
+Create a mumamo chunk at point.
+Run `mumamo-turn-on-hook'.
+
+OLD-MAJOR-MODE is used for the main major mode if the main major
+mode in the chunk family is nil."
+ ;;(unless font-lock-mode (font-lock-mode 1))
+ (mumamo-msgfntfy "mumamo-turn-on-actions")
+ (unless mumamo-current-chunk-family (error "Internal error: Chunk family is not set"))
+ (if (not mumamo-current-chunk-family)
+ (progn
+ (lwarn '(mumamo) :warning
+ "Could not turn on mumamo because chunk family was not set\n\tin buffer %s."
+ (current-buffer))
+ (with-current-buffer "*Warnings*"
+ (insert "\tFor more information see `")
+ (mumamo-insert-describe-button 'define-mumamo-multi-major-mode 'describe-function)
+ (insert "'.\n")))
+ ;; Load major mode:
+ (setq mumamo-org-startup-done nil)
+ (let ((main-major-mode (mumamo-major-mode-from-modespec (mumamo-main-major-mode))))
+ (unless main-major-mode
+ (setcar (cdr mumamo-current-chunk-family) old-major-mode)
+ (setq main-major-mode (mumamo-main-major-mode)))
+ ;;(with-temp-buffer (funcall main-major-mode))
+ (setq mumamo-major-mode main-major-mode)
+ (when (boundp 'nxml-syntax-highlight-flag)
+ (when (mumamo-derived-from-mode main-major-mode 'nxml-mode)
+ (set (make-local-variable 'nxml-syntax-highlight-flag) nil)))
+ ;; Init fontification
+ (mumamo-initialize-state)
+ (mumamo-set-fontification-functions)
+ (mumamo-save-buffer-state nil
+ (remove-list-of-text-properties (point-min) (point-max)
+ (list 'fontified)))
+ ;; For validation header etc:
+ (when (mumamo-derived-from-mode main-major-mode 'nxhtml-mode)
+ (require 'rngalt nil t)
+ (when (featurep 'rngalt)
+ (setq rngalt-major-mode (mumamo-main-major-mode))
+ (rngalt-update-validation-header-overlay))
+ (when (featurep 'rng-valid)
+ (setq rng-get-major-mode-chunk-function 'mumamo-find-chunks)
+ (setq rng-valid-nxml-major-mode-chunk-function 'mumamo-valid-nxml-chunk)
+ (setq rng-end-major-mode-chunk-function 'overlay-end))))
+ ;;(mumamo-set-major-post-command)
+ ;;(add-hook 'change-major-mode-hook 'mumamo-change-major-function nil t)
+ (when (boundp 'flyspell-generic-check-word-predicate)
+ (setq flyspell-generic-check-word-predicate 'mumamo-flyspell-verify))
+ (run-hooks 'mumamo-turn-on-hook)
+ ;;(mumamo-get-chunk-save-buffer-state (point))
+ (let ((buffer-windows (get-buffer-window-list (current-buffer))))
+ (if (not buffer-windows)
+ (let* ((ovl (mumamo-find-chunks (point) "mumamo-turn-on-actions"))
+ (major (when ovl (mumamo-chunk-major-mode ovl))))
+ (when major
+ (mumamo-set-major major ovl)))
+ (dolist (win (get-buffer-window-list (current-buffer) nil t))
+ (let ((wp (or (window-end win)
+ (window-point win)
+ (window-start win))))
+ (mumamo-get-chunk-save-buffer-state wp)
+ (when (eq win (selected-window))
+ (let* ((ovl (mumamo-find-chunks wp "mumamo-turn-on-actions"))
+ (major (when ovl (mumamo-chunk-major-mode ovl))))
+ (when major
+ (mumamo-set-major major ovl))))))))
+ ;;(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))
+ ;; This did not help for Emacs bug 3467:
+ ;;(set-default 'font-lock-keywords-only nil)
+ ;;(setq font-lock-keywords-only nil)
+ )
+ (set (make-local-variable 'font-lock-function) 'mumamo-font-lock-function)
+ (mumamo-emacs-start-bug3467-timer-if-needed)
+ )
+
+;; (defun mumamo-on-font-lock-off ()
+;; "The reverse of `mumamo-turn-on-actions'."
+;; (let ((mumamo-main-major-mode (mumamo-main-major-mode)))
+;; (mumamo-turn-off-actions)
+;; ;; Turning off `font-lock-mode' also turns off `mumamo-mode'. It is
+;; ;; quite tricky to not turn on `font-lock-mode' again in case we got
+;; ;; here because it was turned off. We must first remove the cmhh
+;; ;; function and then also run the internal font lock turn off.
+;; (let* ((flm font-lock-mode)
+;; (flgm global-font-lock-mode)
+;; (remove-cmhh (and (not flm) flgm)))
+;; ;; If remove-cmhh is non-nil then we got here because
+;; ;; `font-lock-mode' was beeing turned off in the buffer, but
+;; ;; `global-font-lock-mode' is still on.
+;; (when remove-cmhh
+;; (remove-hook 'change-major-mode-hook 'global-font-lock-mode-cmhh))
+
+;; (if mumamo-main-major-mode
+;; (funcall mumamo-main-major-mode)
+;; (fundamental-mode))
+
+;; (unless flm
+;; (setq font-lock-mode nil)
+;; (font-lock-mode-internal nil))
+;; (when remove-cmhh
+;; (add-hook 'change-major-mode-hook 'global-font-lock-mode-cmhh)))))
+
+(defun mumamo-turn-off-actions ()
+ "The reverse of `mumamo-turn-on-actions'."
+ (mumamo-msgfntfy "mumamo-turn-off-actions")
+ (when (fboundp 'nxhtml-validation-header-mode)
+ (nxhtml-validation-header-mode -1))
+ (when (mumamo-derived-from-mode
+ (nth 1 mumamo-current-chunk-family) 'nxml-mode)
+ (when (fboundp 'nxml-change-mode)
+ (nxml-change-mode)))
+ (when (and (boundp 'rng-validate-mode)
+ rng-validate-mode)
+ (rng-validate-mode 0))
+ (when (featurep 'rng-valid)
+ (setq rng-get-major-mode-chunk-function nil)
+ (setq rng-valid-nxml-major-mode-chunk-function nil)
+ (setq rng-end-major-mode-chunk-function nil)
+ )
+ ;; Remove nxml for Emacs 22
+ (remove-hook 'after-change-functions 'rng-after-change-function t)
+ (remove-hook 'after-change-functions 'nxml-after-change t)
+ (when (boundp 'rngalt-major-mode)
+ (setq rngalt-major-mode nil))
+ (remove-hook 'change-major-mode-hook 'mumamo-change-major-function t)
+ ;;(mumamo-unfontify-chunks)
+ ;;(remove-hook 'after-change-functions 'mumamo-jit-lock-after-change t)
+ (remove-hook 'after-change-functions 'mumamo-after-change t)
+ (remove-hook 'post-command-hook 'mumamo-post-command t)
+ ;;(remove-hook 'c-special-indent-hook 'mumamo-c-special-indent t)
+ (mumamo-margin-info-mode -1)
+ (when (fboundp 'mumamo-clear-all-regions) (mumamo-clear-all-regions))
+ (save-restriction
+ (widen)
+ (mumamo-save-buffer-state nil
+ (set-text-properties (point-min) (point-max) nil)))
+ (setq mumamo-current-chunk-family nil)
+ (setq mumamo-major-mode nil)
+ (setq mumamo-multi-major-mode nil) ;; for minor-mode-map-alist
+ (setq mumamo-multi-major-mode nil)
+ (mumamo-remove-all-chunk-overlays)
+ (when (fboundp 'rng-cancel-timers) (rng-cancel-timers))
+ )
+
+(defvar mumamo-turn-on-hook nil
+ "Normal hook run after turning on `mumamo-mode'.")
+(put 'mumamo-turn-on-hook 'permanent-local t)
+
+(defvar mumamo-change-major-mode-hook nil
+ "Normal hook run before internal change of major mode.")
+(put 'mumamo-change-major-mode-hook 'permanent-local t)
+
+(defvar mumamo-after-change-major-mode-hook nil
+ "Normal hook run after internal change of major mode.")
+(put 'mumamo-after-change-major-mode-hook 'permanent-local t)
+
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Defining multi major modes
+
+(defvar mumamo-defined-multi-major-modes nil
+ "List of functions defined for turning on mumamo.
+Those functions should be called instead of calling a major mode
+function when you want to use multiple major modes in a buffer.
+They may be added to for example `auto-mode-alist' to
+automatically have the major mode support turned on when opening
+a file.
+
+Each of these functions defines how to mix certain major modes in
+a buffer.
+
+All functions defined by `define-mumamo-multi-major-mode' are
+added to this list. See this function for a general description
+of how the functions work.
+
+If you want to quickly define a new mix of major modes you can
+use `mumamo-quick-static-chunk'.")
+
+;;;###autoload
+(defun mumamo-list-defined-multi-major-modes (show-doc show-chunks match)
+ "List currently defined multi major modes.
+If SHOW-DOC is non-nil show the doc strings added when defining
+them. \(This is not the full doc string. To show the full doc
+string you can click on the multi major mode in the list.)
+
+If SHOW-CHUNKS is non-nil show the names of the chunk dividing
+functions each multi major mode uses.
+
+If MATCH then show only multi major modes whos names matches."
+ (interactive (list (y-or-n-p "Include short doc string? ")
+ (y-or-n-p "Include chunk function names? ")
+ (read-string "List only multi major mode matching regexp (emtpy for all): ")))
+ (with-output-to-temp-buffer (help-buffer)
+ (help-setup-xref (list #'mumamo-list-defined-multi-major-modes) (interactive-p))
+ (with-current-buffer (help-buffer)
+ (insert "The currently defined multi major modes in your Emacs are:\n\n")
+ (let ((mmms (reverse mumamo-defined-multi-major-modes))
+ (here (point)))
+ (setq mmms (sort mmms (lambda (a b)
+ (string< (symbol-name (cdr a))
+ (symbol-name (cdr b))))))
+ (when (string= match "") (setq match nil))
+ (while mmms
+ (let* ((mmm (car mmms))
+ (sym (cdr mmm))
+ (desc (car mmm))
+ (auto (get sym 'autoload))
+ (auto-desc (when auto (nth 1 auto)))
+ (family (get sym 'mumamo-chunk-family))
+ (chunks (nth 2 family)))
+ (when (or (not match)
+ (string-match-p match (symbol-name sym)))
+ (insert " `" (symbol-name sym) "'"
+ " (" desc ")\n"
+ (if (and show-doc auto-desc)
+ (concat " " auto-desc "\n")
+ "")
+ (if show-chunks
+ (format " Chunks:%s\n"
+ (let ((str "")
+ (nn 0))
+ (mapc (lambda (c)
+ (if (< nn 2)
+ (setq str (concat str " "))
+ (setq nn 0)
+ (setq str (concat str "\n ")))
+ (setq nn (1+ nn))
+ (setq str (concat str (format "%-30s" (format "`%s'" c))))
+ )
+ chunks)
+ str))
+ "")
+ (if (or show-doc show-chunks) "\n\n" "")
+ ))
+ (setq mmms (cdr mmms))))
+ ))))
+
+(defun mumamo-describe-chunks (chunks)
+ "Return text describing CHUNKS."
+ (let* ((desc
+ (concat "* Main major mode: `" (symbol-name (nth 1 chunks)) "'\n"
+ "\n* Functions for dividing into submodes:\n")))
+ (dolist (divider (nth 2 chunks))
+ (setq desc
+ (concat
+ desc
+ "\n`" (symbol-name divider)
+ "'\n "
+ (let ((doc (if (functionp divider)
+ (documentation divider t)
+ "(Function not compiled when building doc)")))
+ (if (not doc)
+ "(Not documented)"
+ (substring doc 0 (string-match "\n" doc)))))))
+ (setq desc
+ (concat
+ desc
+ "\n\n(Note that the functions for dividing into chunks returns\n"
+ "a major mode specifier which may be translated into a major mode\n"
+ "by `mumamo-main-major-mode'.)\n"))
+ desc))
+
+(defun mumamo-add-multi-keymap (toggle keymap)
+ "Add TOGGLE and KEYMAP to `minor-mode-map-alist'.
+This is used to add a keymap to multi major modes since the local
+keymap is occupied by the major modes.
+
+It is also used to add the `mumamo-map' keymap to every buffer
+with a multi major mode."
+ ;; Copied from add-minor-mode
+ ;; Add the map to the minor-mode-map-alist.
+ (when keymap
+ (let ((existing (assq toggle minor-mode-map-alist))
+ (after t))
+ (if existing
+ (setcdr existing keymap)
+ (let ((tail minor-mode-map-alist) found)
+ (while (and tail (not found))
+ (if (eq after (caar tail))
+ (setq found tail)
+ (setq tail (cdr tail))))
+ (if found
+ (let ((rest (cdr found)))
+ (setcdr found nil)
+ (nconc found (list (cons toggle keymap)) rest))
+ (setq minor-mode-map-alist (cons (cons toggle keymap)
+ minor-mode-map-alist))))))))
+
+(defvar mumamo-map
+ (let ((map (make-sparse-keymap)))
+ (define-key map [(control meta prior)] 'mumamo-backward-chunk)
+ (define-key map [(control meta next)] 'mumamo-forward-chunk)
+ ;; Use mumamo-indent-line-function:
+ ;;(define-key map [tab] 'indent-for-tab-command)
+ (define-key map [(meta ?q)] 'fill-paragraph)
+ map)
+ "Keymap that is active in all mumamo buffers.
+It has the some priority as minor mode maps.")
+;;(make-variable-buffer-local 'mumamo-map)
+(put 'mumamo-map 'permanent-local t)
+
+(mumamo-add-multi-keymap 'mumamo-multi-major-mode mumamo-map)
+
+;;;###autoload
+(defun mumamo-multi-major-modep (value)
+ "Return t if VALUE is a multi major mode function."
+ (and (fboundp value)
+ (rassq value mumamo-defined-multi-major-modes)))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Indenting, filling, moving etc
+
+;; FIX-ME: Indentation in perl here doc indents the ending mark which
+;; corrupts the perl here doc.
+
+(defun mumamo-indent-line-function ()
+ "Function to indent the current line.
+This is the buffer local value of `indent-line-function' when
+mumamo is used."
+ (let ((here (point-marker))
+ fontification-functions
+ rng-nxml-auto-validate-flag
+ (before-text (<= (current-column) (current-indentation))))
+ (mumamo-indent-line-function-1 nil nil nil)
+ ;; If the marker was in the indentation part strange things happen
+ ;; if we try to go back to the marker, at least in php-mode parts.
+ (if before-text
+ (back-to-indentation)
+ (goto-char here))))
+
+(defun mumamo-indent-current-line-chunks (last-chunk-prev-line)
+ "Return a list of chunks to consider when indenting current line.
+This list consists of four chunks at these positions:
+- Beginning of line - 1
+- Beginning of line
+- End of line
+- End of line + 1"
+ ;; Fix-me: must take markers into account too when a submode
+ ;; includes the markers.
+ (setq last-chunk-prev-line nil)
+ ;;(msgtrc "indent-current-line-chunks: last-chunk-prev-line=%S" last-chunk-prev-line)
+ (save-restriction
+ (widen)
+ (let* ((lb-pos (line-beginning-position))
+ (le-pos (line-end-position))
+ (pos0 (if (> lb-pos (point-min))
+ (1- lb-pos)
+ (point-min)))
+ (pos1 lb-pos)
+ (pos2 le-pos)
+ (pos3 (if (< le-pos (point-max))
+ (+ 1 le-pos)
+ (point-max)))
+ ;; Create all chunks on this line first, then grab them
+ (ovl3 (mumamo-find-chunks pos3 "mumamo-indent-current-line-chunks"))
+ (ovl2 (if (>= pos2 (overlay-start ovl3))
+ ovl3
+ (mumamo-get-existing-new-chunk-at pos2)))
+ (ovl1 (if (>= pos1 (overlay-start ovl2))
+ ovl2
+ (mumamo-get-existing-new-chunk-at pos1)))
+ (ovl0 (if (> pos0 (overlay-start ovl1))
+ ovl1
+ (mumamo-get-existing-new-chunk-at pos0 t))))
+ (list ovl0 ovl1 ovl2 ovl3))))
+
+;; Fix-me: need to back up past comments in for example
+ Going out this line; First char inner or outer; line end outer;
+
+ 3)
+ Going out this line; first char inner; line end outer;
+
+ From this we deduce the following way to compute if we are
+ going in or out:
+
+ - Odd above (going in): Compare prev line end's mumamo-depth
+ with current line end's dito. Set flag for first line in
+ chunk.
+
+ - Even above (going out): Same test as for going in, but going
+ out happens on current line.
+"
+ ;;(msgtrc "indent-line-function-1 blp=%s" (line-beginning-position))
+ (setq prev-line-chunks nil)
+ ;;(setq last-parent-major-indent nil)
+ ;;(setq entering-submode-arg nil)
+ (unless prev-line-chunks
+ (save-excursion
+ (goto-char (line-beginning-position 1))
+ (unless (= (point) 1)
+ (skip-chars-backward "\n\t ")
+ (goto-char (line-beginning-position 1))
+ (setq prev-line-chunks (mumamo-indent-current-line-chunks nil))
+ ;;(msgtrc "%d:prev-line-chunks=%S" (save-restriction (widen) (line-number-at-pos)) prev-line-chunks )
+ )))
+ (let* ((prev-line-chunk0 (nth 0 prev-line-chunks))
+ (prev-line-chunk2 (nth 2 prev-line-chunks))
+ (prev-line-chunk3 (nth 3 prev-line-chunks))
+ (prev-line-major0 (mumamo-chunk-major-mode (nth 0 prev-line-chunks)))
+ (prev-line-major1 (mumamo-chunk-major-mode (nth 1 prev-line-chunks)))
+ (prev-line-major2 (mumamo-chunk-major-mode (nth 2 prev-line-chunks)))
+ (prev-line-major3 (mumamo-chunk-major-mode (nth 3 prev-line-chunks)))
+ (prev-depth2 (if prev-line-chunk2
+ (overlay-get prev-line-chunk2 'mumamo-depth)
+ 0))
+ (prev-depth3 (if prev-line-chunk3
+ (overlay-get prev-line-chunk3 'mumamo-depth)
+ 0))
+
+ (this-line-chunks (mumamo-indent-current-line-chunks (nth 3 prev-line-chunks)))
+ ;;(dummy (msgtrc "%d:this-line-chunks=%S" (save-restriction (widen) (line-number-at-pos)) this-line-chunks))
+ (this-line-chunk0 (nth 0 this-line-chunks))
+ (this-line-chunk2 (nth 2 this-line-chunks))
+ (this-line-chunk3 (nth 3 this-line-chunks))
+ (this-line-major0 (mumamo-chunk-major-mode (nth 0 this-line-chunks)))
+ (this-line-major1 (mumamo-chunk-major-mode (nth 1 this-line-chunks)))
+ (this-line-major2 (mumamo-chunk-major-mode (nth 2 this-line-chunks)))
+ (this-line-major3 (mumamo-chunk-major-mode (nth 3 this-line-chunks)))
+ (this-depth2 (overlay-get this-line-chunk2 'mumamo-depth))
+ (this-depth3 (overlay-get this-line-chunk3 'mumamo-depth))
+
+ ;;(dummy (msgtrc "a\t this=%S" this-line-chunks))
+ this-line-indent-major
+ major-indent-line-function
+ (main-major (mumamo-main-major-mode))
+ (old-indent (current-indentation))
+ (next-entering-submode (if (< prev-depth3 this-depth3) 'yes 'no))
+ (entering-submode
+ ;; Fix-me
+ (progn
+ (unless nil ;entering-submode-arg
+ (let* ((prev-prev-line-chunks
+ (save-excursion
+ (goto-char (line-beginning-position 0))
+ (unless (bobp)
+ (skip-chars-backward "\n\t ")
+ (goto-char (line-beginning-position 1))
+ (let ((chunks (mumamo-indent-current-line-chunks nil)))
+ ;;(msgtrc "%d:prev-prev-line-chunks=%S" (save-restriction (widen) (line-number-at-pos)) chunks)
+ chunks))))
+ (prev-prev-line-chunk2 (nth 2 prev-prev-line-chunks))
+ (prev-prev-line-chunk3 (nth 3 prev-prev-line-chunks))
+ (prev-prev-depth2 (when prev-prev-line-chunk2
+ (overlay-get prev-prev-line-chunk2 'mumamo-depth)))
+ (prev-prev-depth3 (when prev-prev-line-chunk3
+ (overlay-get prev-prev-line-chunk3 'mumamo-depth))))
+ ;;(msgtrc "depths 2=%s/%s/%s 3=%s/%s/%s" prev-prev-depth2 prev-depth2 this-depth2 prev-prev-depth3 prev-depth3 this-depth3)
+ (setq entering-submode-arg
+ (if prev-prev-depth2
+ (if (and (eq prev-prev-line-chunk2
+ (overlay-get prev-line-chunk2 'mumamo-prev-chunk))
+ (< prev-prev-depth2 prev-depth2))
+ 'yes
+ 'no)
+ (if (> this-depth2 0) 'yes 'no)
+ ))
+ ))
+ (eq 'yes entering-submode-arg)
+ )) ;; fix-me
+ ;; Fix-me
+ (leaving-submode (> prev-depth2 this-depth2))
+ want-indent ;; The indentation we desire
+ got-indent
+ (here-on-line (point-marker))
+ this-pending-undo-list
+ (while-n1 0)
+ (while-n2 0)
+ (while-n3 0)
+ ;; Is there a possible indentor chunk on this line?:
+ (this-line-indentor-chunk (when (> (overlay-start this-line-chunk2)
+ (point-at-bol))
+ (overlay-get this-line-chunk2 'mumamo-prev-chunk)))
+ ;;(dummy (msgtrc "this-line-indentor-chunk=%S" this-line-indentor-chunk))
+ ;; Check if this really is an indentor chunk:
+ ;; Fix-me: 'mumamo-indentor is not put on the chunk yet since
+ ;; it is done in mumamo-template-indent-get-chunk-shift ... -
+ ;; and now it is calle too often ...
+ (this-line-indentor-prev (when this-line-indentor-chunk
+ (overlay-get this-line-indentor-chunk 'mumamo-prev-chunk)))
+ (this-line-is-indentor (and this-line-indentor-prev
+ (eq (overlay-get this-line-indentor-prev 'mumamo-next-indent)
+ 'mumamo-template-indentor)
+ (progn
+ (goto-char (overlay-start this-line-indentor-chunk))
+ (back-to-indentation)
+ (= (point) (overlay-start this-line-indentor-chunk)))))
+ ;; Fix-me: rewrite and reorder. We do not need both shift-in and shift-out
+ (this-template-shift (when this-line-is-indentor
+ (mumamo-template-indent-get-chunk-shift this-line-indentor-chunk)))
+ ;;(dummy (msgtrc "this-line-indentor=%s, %S" this-template-shift this-line-is-indentor))
+ ;; Fix-me: skip over blank lines backward here:
+ (prev-template-indentor (when prev-line-chunk0
+ (unless (eq this-line-chunk0 prev-line-chunk0)
+ (let* ((prev (overlay-get this-line-chunk0 'mumamo-prev-chunk))
+ (prev-prev (overlay-get prev 'mumamo-prev-chunk)))
+ (when (and (eq prev-prev prev-line-chunk0)
+ (eq (overlay-get prev-prev 'mumamo-next-indent)
+ 'mumamo-template-indentor))
+ prev)))))
+ (prev-template-shift-rec (when prev-template-indentor
+ (mumamo-template-indent-get-chunk-shift prev-template-indentor)
+ ))
+ (template-shift (if (and (car this-template-shift) (/= 0 (car this-template-shift)))
+ (car this-template-shift)
+ (when prev-template-shift-rec
+ (cdr prev-template-shift-rec))))
+ (template-indent-abs (when (and template-shift
+ (/= 0 template-shift))
+ (+ template-shift
+ (let ((here (point)))
+ (if prev-template-indentor
+ (goto-char (overlay-start prev-template-indentor))
+ (goto-char (overlay-start this-line-indentor-chunk))
+ (skip-chars-backward " \t\r\n\f"))
+ (prog1
+ (current-indentation)
+ (goto-char here))))))
+ )
+ (when (and leaving-submode entering-submode)
+ (message "Do not know how to indent here (both leaving and entering sub chunks)")
+ )
+ ;; Fix-me: indentation
+ ;;(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)
+ (when (or leaving-submode entering-submode)
+ (unless last-parent-major-indent
+ (save-excursion
+ ;;(while (and (> 500 (setq while-n1 (1+ while-n1)))
+ (while (and (mumamo-while 500 'while-n1 "last-parent-major-indent")
+ (not last-parent-major-indent))
+ (if (bobp)
+ (setq last-parent-major-indent 0)
+ (goto-char (line-beginning-position 0))
+ (when (mumamo-fun-eq main-major
+ (mumamo-chunk-major-mode
+ (car
+ (mumamo-indent-current-line-chunks nil)))
+ )
+ (skip-chars-forward " \t")
+ (if (eolp)
+ (setq last-parent-major-indent 0)
+ (setq last-parent-major-indent (current-column)))))))))
+ (mumamo-msgindent " leaving-submode=%s, entering-submode=%s" leaving-submode entering-submode)
+ ;;(msgtrc " leaving-submode=%s, entering-submode=%s, template-indentor=%s" leaving-submode entering-submode template-indentor)
+
+ ;; Fix-me: use this.
+ ;; - clean up after chunk deletion
+ ;; - next line after a template-indentor, what happens?
+ ;;(setq template-indentor nil) ;; fix-me
+ (cond
+ ( template-indent-abs
+ (setq want-indent (max 0 template-indent-abs)))
+ ( leaving-submode
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;;;;; First line after submode
+ (mumamo-msgindent " leaving last-parent-major-indent=%s" last-parent-major-indent)
+ (if (eq (overlay-get (overlay-get this-line-chunk0 'mumamo-prev-chunk)
+ 'mumamo-next-indent)
+ 'heredoc)
+ (setq want-indent 0)
+ (setq want-indent last-parent-major-indent)))
+
+ ( entering-submode
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;;;;; First line in submode
+ ;;(setq this-line-indent-major this-line-major0)
+ (setq this-line-indent-major (mumamo-indent-get-major-to-use this-line-major0 this-depth3))
+ ;;(when (and prev-line-major0 (not (mumamo-fun-eq this-line-major0 prev-line-major0))) (setq this-line-indent-major prev-line-major0))
+ (mumamo-msgindent " this-line-indent-major=%s, major-mode=%s this0=%s" this-line-indent-major major-mode this-line-major0)
+ (mumamo-msgindent " mumamo-submode-indent-offset=%s" mumamo-submode-indent-offset)
+ (unless (mumamo-fun-eq this-line-indent-major major-mode)
+ (mumamo-set-major this-line-indent-major this-line-chunk0))
+ (setq want-indent (+ last-parent-major-indent
+ (if (= 0 last-parent-major-indent)
+ (if mumamo-submode-indent-offset-0
+ mumamo-submode-indent-offset-0
+ -1000)
+ (if mumamo-submode-indent-offset
+ mumamo-submode-indent-offset
+ -1000))))
+ (unless (< 0 want-indent) (setq want-indent nil))
+ (when (and want-indent (mumamo-indent-use-widen major-mode))
+ ;; In this case only use want-indent if it is bigger than the
+ ;; indentation calling indent-line-function would give.
+ (condition-case nil
+ (atomic-change-group
+ (mumamo-call-indent-line (nth 0 this-line-chunks))
+ (when (> want-indent (current-indentation))
+ (signal 'mumamo-error-ind-0 nil))
+ (setq want-indent nil))
+ (mumamo-error-ind-0)))
+ (unless want-indent
+ (mumamo-call-indent-line (nth 0 this-line-chunks)))
+ (mumamo-msgindent " enter sub.want-indent=%s, curr=%s, last-main=%s" want-indent (current-indentation)
+ last-parent-major-indent)
+ ;;(unless (> want-indent (current-indentation)) (setq want-indent nil))
+ )
+
+ ( t
+ ;; We have to change major mode, because we know nothing
+ ;; about the requirements of the indent-line-function:
+ ;; Fix-me: This may be cured by RMS suggestion to
+ ;; temporarily set all variables back to global values?
+ (setq this-line-indent-major (mumamo-indent-get-major-to-use this-line-major0 this-depth3))
+ (mumamo-msgindent " this-line-indent-major=%s" this-line-indent-major)
+ (unless (mumamo-fun-eq this-line-indent-major major-mode) (mumamo-set-major this-line-indent-major this-line-chunk0))
+ ;; Use the major mode at the beginning of since a sub chunk may
+ ;; start at start of line.
+ (if (mumamo-fun-eq this-line-major1 main-major)
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;;;;; In main major mode
+ ;;
+ ;; Take care of the case when all the text is in a
+ ;; sub chunk. In that case use the same indentation as if
+ ;; the code all belongs to the surrounding major mode.
+ (let ((here (point))
+ (use-widen (mumamo-indent-use-widen main-major)))
+ ;; If we can't indent indent using the main major mode
+ ;; because it is only blanks and we should not widen,
+ ;; then use the indentation on the line where it starts.
+ (mumamo-msgindent " In main major mode")
+ (forward-line 0)
+ (skip-chars-backward " \t\n\r\f")
+ (forward-line 0)
+ (if (or use-widen (>= (point) (overlay-start this-line-chunk0)))
+ (progn
+ (goto-char here)
+ (mumamo-call-indent-line this-line-chunk0))
+ (setq want-indent (current-indentation))
+ (goto-char here))
+ (mumamo-msgindent " In main major mode B")
+ (setq last-parent-major-indent (current-indentation)))
+ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+ ;;;;; In sub major mode
+ ;;
+ ;; Get the indentation the major mode alone would use:
+ ;;(setq got-indent (mumamo-get-major-mode-indent-column))
+ ;; Since this line has another major mode than the
+ ;; previous line we instead want to indent relative to
+ ;; that line in a way decided in mumamo:
+ (mumamo-msgindent " In sub major mode")
+ (let ((chunk (mumamo-get-chunk-save-buffer-state (point)))
+ (font-lock-dont-widen t)
+ ind-zero
+ (here (point))
+ ind-on-first-sub-line)
+ (save-restriction
+ (mumamo-update-obscure chunk here)
+ (let ((syn-min-max (mumamo-chunk-syntax-min-max chunk nil)))
+ (narrow-to-region (car syn-min-max)
+ (cdr syn-min-max)))
+ (condition-case nil
+ (atomic-change-group
+ (mumamo-call-indent-line (nth 0 this-line-chunks))
+ (when (= 0 (current-indentation))
+ (setq ind-zero t)
+ ;; It is maybe ok if indentation on first sub
+ ;; line is 0 so check that:
+ (goto-char (point-min))
+ (widen)
+ (setq ind-on-first-sub-line (current-indentation))
+ (goto-char here)
+ (signal 'mumamo-error-ind-0 nil)))
+ (mumamo-error-ind-0))
+ ;; Unfortunately the indentation can sometimes get 0
+ ;; here even though it is clear it should not be 0. This
+ ;; happens when there are only comments or empty lines
+ ;; above.
+ ;;
+ ;; See c:/test/erik-lilja-index.php for an example.
+ (when ind-zero ;(and t (= 0 (current-indentation)))
+ (save-excursion
+ (setq want-indent 0)
+ (unless (= 0 ind-on-first-sub-line)
+ ;;(while (and (> 500 (setq while-n2 (1+ while-n2)))
+ (while (and (mumamo-while 500 'while-n2 "want-indent")
+ (= 0 want-indent)
+ (/= (point) (point-min)))
+ (beginning-of-line 0)
+ (setq want-indent (current-indentation)))
+ ;; Now if want-indent is still 0 we need to look further above
+ (when (= 0 want-indent)
+ (widen)
+ ;;(while (and (> 500 (setq while-n3 (1+ while-n3)))
+ (while (and (mumamo-while 500 'while-n3 "want-indent 2")
+ (= 0 want-indent)
+ (/= (point) (point-min)))
+ (beginning-of-line 0)
+ (setq want-indent (current-indentation)))
+ ;; If we got to the main major mode we need to add
+ ;; the special submode offset:
+ (let* ((ovl (mumamo-get-chunk-save-buffer-state (point)))
+ (major (mumamo-chunk-major-mode ovl)))
+ (when (mumamo-fun-eq major main-major)
+ (setq want-indent (+ want-indent
+ (if (= 0 want-indent)
+ mumamo-submode-indent-offset-0
+ mumamo-submode-indent-offset)))))))))
+ )))))
+ (when want-indent
+ ;;(msgtrc "indent-line-to %s at line-beginning=%s" want-indent (line-beginning-position))
+ (indent-line-to want-indent))
+ ;; (when (and template-shift (/= 0 template-shift))
+ ;; (let ((ind (+ (current-indentation) template-shift)))
+ ;; (indent-line-to ind)))
+ ;; (when template-indent-abs
+ ;; (indent-line-to template-indent-abs))
+ (goto-char here-on-line)
+ ;;(msgtrc "exit: %s" (list this-line-chunks last-parent-major-indent))
+ (list this-line-chunks last-parent-major-indent next-entering-submode)))
+
+;; Fix-me: use this for first line in a submode
+;; Fix-me: check more carefully for widen since it may lead to bad results.
+(defun mumamo-indent-use-widen (major-mode)
+ "Return non-nil if widen before indentation in MAJOR-MODE."
+ (let* ((specials (cadr (assoc major-mode mumamo-indent-widen-per-major)))
+ (use-widen (memq 'use-widen specials))
+ (use-widen-maybe (assq 'use-widen specials)))
+ (or use-widen
+ (memq mumamo-multi-major-mode (cadr use-widen-maybe)))))
+;;(mumamo-indent-use-widen 'php-mode)
+;;(mumamo-indent-use-widen 'nxhtml-mode)
+;;(mumamo-indent-use-widen 'html-mode)
+
+;; Fix-me: remove
+;; (defun mumamo-indent-special-or-default (default-indent)
+;; "Indent to DEFAULT-INDENT unless a special indent can be done."
+;; (mumamo-with-major-mode-indentation major-mode
+;; `(progn
+;; (if (mumamo-indent-use-widen major-mode)
+;; (save-restriction
+;; (widen)
+;; (mumamo-msgindent "=> special-or-default did widen, %s" major-mode)
+;; (funcall indent-line-function))
+;; (indent-to-column default-indent)))))
+
+(defun mumamo-call-indent-line (chunk)
+ "Call the relevant `indent-line-function'."
+ ;;(msgtrc "call-indent-line %s, lbp=%s" chunk (line-beginning-position))
+ (if nil
+ (mumamo-with-major-mode-indentation major-mode
+ `(save-restriction
+ (when (mumamo-indent-use-widen major-mode)
+ (mumamo-msgindent "=> indent-line did widen")
+ (widen))
+ (funcall indent-line-function)))
+ (let ((maj (car mumamo-major-mode-indent-line-function))
+ (fun (cdr mumamo-major-mode-indent-line-function)))
+ (assert (mumamo-fun-eq maj major-mode))
+ (save-restriction
+ ;; (unless (mumamo-indent-use-widen major-mode)
+ ;; (let ((syn-min-max (mumamo-chunk-syntax-min-max chunk nil)))
+ ;; (narrow-to-region (car syn-min-max) (cdr syn-min-max))))
+ (let ((mumamo-stop-widen (not (mumamo-indent-use-widen major-mode))))
+ (if (not mumamo-stop-widen)
+ (widen)
+ (let ((syn-min-max (mumamo-chunk-syntax-min-max chunk nil)))
+ (narrow-to-region (car syn-min-max) (cdr syn-min-max))))
+ ;;(msgtrc "call-indent-line fun=%s" fun)
+ ;;(funcall fun)
+ ;; Fix-me: Use mumamo-funcall-evaled to avoid (widen):
+ (mumamo-funcall-evaled fun)
+ )))))
+
+(defvar mumamo-stop-widen nil)
+(when nil
+ (let* ((fun 'describe-variable)
+ (lib (symbol-file fun 'defun)))
+ (find-function-search-for-symbol fun nil lib)))
+
+(defun mumamo-funcall-evaled (fun &rest args)
+ "Make sure FUN is evaled, then call it.
+This make sure (currently) that defadvice for primitives are
+called. They are not called in byte compiled code.
+
+See URL `http://debbugs.gnu.org/cgi/bugreport.cgi?bug=5863' since
+this may change."
+ (when mumamo-stop-widen
+ (unless (get fun 'mumamo-evaled)
+ (let* ((lib (symbol-file fun 'defun))
+ (where (find-function-search-for-symbol fun nil lib))
+ (buf (car where))
+ (pos (cdr where)))
+ (with-current-buffer buf
+ (let ((close (and (not (buffer-modified-p))
+ (= 1 (point)))))
+ ;;(goto-char pos) (eval-defun nil)
+ (msgtrc "mumamo-funcall-evaled %s" (current-buffer))
+ (eval-buffer)
+ (when close (kill-buffer))))
+ (put fun 'mumamo-evaled t))))
+ (apply 'funcall fun args))
+
+;;(require 'advice)
+(defun mumamo-defadvice-widen ()
+ (defadvice widen (around
+ mumamo-ad-widen
+ activate
+ compile
+ )
+ (unless (and mumamo-multi-major-mode
+ mumamo-stop-widen)
+ ad-do-it)))
+(eval-after-load 'mumamo
+ '(mumamo-defadvice-widen))
+
+;; (defadvice font-lock-fontify-buffer (around
+;; mumam-ad-font-lock-fontify-buffer
+;; activate
+;; compile
+;; )
+;; (if mumamo-multi-major-mode
+;; (save-restriction
+;; (let* ((chunk (mumamo-find-chunks (point) "font-lock-fontify-buffer advice"))
+;; (syn-min-max (mumamo-chunk-syntax-min-max chunk nil))
+;; (syn-min (car syn-min-max))
+;; (syn-max (cdr syn-min-max))
+;; (mumamo-stop-widen t))
+;; (narrow-to-region syn-min syn-max)
+;; (font-lock-fontify-region syn-min syn-max)))
+;; ad-do-it))
+
+(defun mumamo-indent-region-function (start end)
+ "Indent the region between START and END."
+ (save-excursion
+ (setq end (copy-marker end))
+ (goto-char start)
+ (let ((old-point -1)
+ prev-line-chunks
+ last-parent-major-indent
+ entering-submode-arg
+ ;; Turn off validation during indentation
+ (old-rng-validate-mode (when (boundp 'rng-validate-mode) rng-validate-mode))
+ (rng-nxml-auto-validate-flag nil)
+ (nxhtml-use-imenu nil)
+ fontification-functions
+ rng-nxml-auto-validate-flag
+ (nxhtml-mode-hook (mumamo-get-hook-value
+ 'nxhtml-mode-hook
+ '(html-imenu-setup)))
+ ;;
+ (while-n1 0))
+ (when old-rng-validate-mode (rng-validate-mode -1))
+ ;;(while (and (> 3000 (setq while-n1 (1+ while-n1)))
+ (while (and (mumamo-while 3000 'while-n1 "indent-region")
+ (< (point) end)
+ (/= old-point (point)))
+ ;;(message "mumamo-indent-region-function, point=%s" (point))
+ (or (and (bolp) (eolp))
+ (let ((ret (mumamo-indent-line-function-1
+ prev-line-chunks
+ last-parent-major-indent
+ entering-submode-arg)))
+ (setq prev-line-chunks (nth 0 ret))
+ (setq last-parent-major-indent (nth 1 ret))
+ (setq entering-submode-arg (nth 2 ret))))
+ (setq old-point (point))
+ (forward-line 1))
+ (when old-rng-validate-mode (rng-validate-mode 1)))
+ (message "Ready indenting region")))
+
+
+(defun mumamo-fill-forward-paragraph-function(&optional arg)
+ "Function to move over paragraphs used by filling code.
+This is the buffer local value of
+`fill-forward-paragraph-function' when mumamo is used."
+ ;; fix-me: Do this chunk by chunk
+ ;; Fix-me: use this (but only in v 23)
+ (let* ((ovl (mumamo-get-chunk-save-buffer-state (point)))
+ (major (mumamo-chunk-major-mode ovl)))
+ (mumamo-with-major-mode-fontification major
+ fill-forward-paragraph-function)))
+
+(defun mumamo-fill-chunk (&optional justify)
+ "Fill each of the paragraphs in the current chunk.
+Narrow to chunk region trimmed white space at the ends. Then
+call `fill-region'.
+
+The argument JUSTIFY is the same as in `fill-region' and a prefix
+behaves the same way as there."
+ (interactive (progn
+ (barf-if-buffer-read-only)
+ (list (if current-prefix-arg 'full))))
+ (let* ((ovl (mumamo-get-chunk-save-buffer-state (point)))
+ (major (mumamo-chunk-major-mode ovl)))
+ ;; Fix-me: There must be some bug that makes it necessary to
+ ;; always change mode when fill-paragraph-function is
+ ;; c-fill-paragraph.
+
+ ;;(unless (mumamo-fun-eq major major-mode) (mumamo-set-major major ovl))
+ (mumamo-set-major major ovl)
+
+ (save-restriction
+ (mumamo-update-obscure ovl (point))
+ (let* ((syn-min-max (mumamo-chunk-syntax-min-max ovl nil))
+ (syn-min (car syn-min-max))
+ (syn-max (cdr syn-min-max))
+ use-min
+ (here (point-marker)))
+ (goto-char syn-min)
+ (skip-syntax-forward " ")
+ ;; Move back over chars that have whitespace syntax but have the p flag.
+ (backward-prefix-chars)
+ (setq use-min (point))
+ (goto-char syn-max)
+ (skip-syntax-backward " ")
+ (fill-region use-min (point) justify)))))
+
+;; (defvar mumamo-dont-widen)
+;; (defadvice widen (around
+;; mumamo-ad-widen
+;; activate
+;; disable
+;; compile
+;; )
+;; "Make `widen' do nothing.
+;; This is for `mumamo-fill-paragraph-function' and is necessary
+;; when `c-fill-paragraph' is the real function used."
+;; (unless (and (boundp 'mumamo-dont-widen)
+;; mumamo-dont-widen)
+;; ad-do-it))
+
+(defadvice flymake-display-warning (around
+ mumamo-ad-flymake-display-warning
+ activate
+ compile)
+ "Display flymake warnings in the usual Emacs way."
+ (let ((msg (ad-get-arg 0)))
+ ;; Fix-me: Can't get backtrace here. Report it.
+ ;;(setq msg (format (concat msg "\n%S" (with-output-to-string (backtrace)))))
+ (lwarn '(flymake) :error msg)))
+;;(lwarn '(flymake) :error "the warning")
+
+(defun mumamo-forward-chunk ()
+ "Move forward to next chunk."
+ (interactive)
+ (let* ((chunk (mumamo-get-chunk-save-buffer-state (point)))
+ (end-pos (overlay-end chunk)))
+ (goto-char (min end-pos
+ (point-max)))))
+
+(defun mumamo-backward-chunk ()
+ "Move backward to previous chunk."
+ (interactive)
+ (let* ((chunk (mumamo-get-chunk-save-buffer-state (point)))
+ (start-pos (overlay-start chunk)))
+ (goto-char (max (1- start-pos)
+ (point-min)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;; Spell checking
+
+(defun mumamo-flyspell-verify ()
+ "Function used for `flyspell-generic-check-word-predicate'."
+ (let* ((chunk (when mumamo-multi-major-mode
+ (mumamo-find-chunks (point) "mumamo-lyspell-verify")))
+ (chunk-major (when chunk (mumamo-chunk-major-mode chunk)))
+ (mode-predicate (when chunk-major
+ (let ((predicate (get chunk-major
+ 'flyspell-mode-predicate)))
+ (if predicate
+ predicate
+ (if (mumamo-derived-from-mode chunk-major
+ 'text-mode)
+ nil
+ 'flyspell-generic-progmode-verify)))))
+ )
+ (if mode-predicate
+ ;; Fix-me: (run-hooks 'flyspell-prog-mode-hook)
+ (funcall mode-predicate)
+ t)))
+
+;; (featurep 'cc-engine)
+(eval-after-load 'cc-engine
+ (progn
+ ;; From Alan's mail 2009-12-03: C Mode: acceleration in brace
+ ;; deserts.
+ ;; Fix-me: Should they be here, or...?
+ (put 'c-state-cache 'permanent-local t)
+ (put 'c-state-cache-good-pos 'permanent-local t)
+ (put 'c-state-nonlit-pos-cache 'permanent-local t)
+ (put 'c-state-nonlit-pos-cache-limit 'permanent-local t)
+ (put 'c-state-brace-pair-desert 'permanent-local t)
+ (put 'c-state-point-min 'permanent-local t)
+ (put 'c-state-point-min-lit-type 'permanent-local t)
+ (put 'c-state-point-min-lit-start 'permanent-local t)
+ (put 'c-state-min-scan-pos 'permanent-local t)
+ (put 'c-state-old-cpp-beg 'permanent-local t)
+ (put 'c-state-old-cpp-end 'permanent-local t)
+
+ ))
+
+;; Fix-me: Seems perhaps like c-state-point-min-lit-start is reset in
+;; c-state-mark-point-min-literal because c-state-literal-at returns
+;; nil. (Or is (car lit) nil?)
+
+(defvar mumamo-c-state-cache-init nil)
+(make-variable-buffer-local 'mumamo-c-state-cache-init)
+(put 'mumamo-c-state-cache-init 'permanent-local t)
+
+(defun mumamo-c-state-cache-init ()
+ (unless mumamo-c-state-cache-init
+ ;;(msgtrc "c-state-cache-init running")
+ (setq mumamo-c-state-cache-init t)
+ (setq c-state-cache (or c-state-cache nil))
+ (put 'c-state-cache 'permanent-local t)
+ (setq c-state-cache-good-pos (or c-state-cache-good-pos 1))
+ (put 'c-state-cache-good-pos 'permanent-local t)
+ (setq c-state-nonlit-pos-cache (or c-state-nonlit-pos-cache nil))
+ (put 'c-state-nonlit-pos-cache 'permanent-local t)
+ (setq c-state-nonlit-pos-cache-limit (or c-state-nonlit-pos-cache-limit 1))
+ (put 'c-state-nonlit-pos-cache-limit 'permanent-local t)
+ (setq c-state-brace-pair-desert (or c-state-brace-pair-desert nil))
+ (put 'c-state-brace-pair-desert 'permanent-local t)
+ (setq c-state-point-min (or c-state-point-min 1))
+ (put 'c-state-point-min 'permanent-local t)
+ (setq c-state-point-min-lit-type (or c-state-point-min-lit-type nil))
+ (put 'c-state-point-min-lit-type 'permanent-local t)
+ (setq c-state-point-min-lit-start (or c-state-point-min-lit-start nil))
+ (put 'c-state-point-min-lit-start 'permanent-local t)
+ (setq c-state-min-scan-pos (or c-state-min-scan-pos 1))
+ (put 'c-state-min-scan-pos 'permanent-local t)
+ (setq c-state-old-cpp-beg (or c-state-old-cpp-beg nil))
+ (put 'c-state-old-cpp-beg 'permanent-local t)
+ (setq c-state-old-cpp-end (or c-state-old-cpp-end nil))
+ (put 'c-state-old-cpp-end 'permanent-local t)
+ (c-state-mark-point-min-literal)))
+
+(defadvice c-state-cache-init (around
+ mumamo-ad-c-state-cache-init
+ activate
+ compile
+ )
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (mumamo-c-state-cache-init)))
+
+;; Fix-me: Have to add per chunk local majors for this one.
+(defun mumamo-c-state-literal-at (here)
+ ;; If position HERE is inside a literal, return (START . END), the
+ ;; boundaries of the literal (which may be outside the accessible bit of the
+ ;; buffer). Otherwise, return nil.
+ ;;
+ ;; This function is almost the same as `c-literal-limits'. It differs in
+ ;; that it is a lower level function, and that it rigourously follows the
+ ;; syntax from BOB, whereas `c-literal-limits' uses a "local" safe position.
+ (let* ((is-here (point))
+ (s (syntax-ppss here))
+ (ret (when (or (nth 3 s) (nth 4 s)) ; in a string or comment
+ (parse-partial-sexp (point) (point-max)
+ nil ; TARGETDEPTH
+ nil ; STOPBEFORE
+ s ; OLDSTATE
+ 'syntax-table) ; stop at end of literal
+ (cons (nth 8 s) (point)))))
+ (goto-char is-here)
+ ret))
+
+;; (save-restriction
+;; (widen)
+;; (let* ((chunk (mumamo-find-chunks (point) "mumamo-c-state-literal-at"))
+;; (syntax-min-max (mumamo-chunk-syntax-min-max chunk t)))
+;; (narrow-to-region (car syntax-min-max) (cdr syntax-min-max)))
+;; (save-excursion
+;; (let ((c c-state-nonlit-pos-cache)
+;; pos npos lit)
+;; ;; Trim the cache to take account of buffer changes.
+;; (while (and c (> (car c) c-state-nonlit-pos-cache-limit))
+;; (setq c (cdr c)))
+;; (setq c-state-nonlit-pos-cache c)
+
+;; (while (and c (> (car c) here))
+;; (setq c (cdr c)))
+;; (setq pos (or (car c) (point-min)))
+
+;; (while (<= (setq npos (+ pos c-state-nonlit-pos-interval))
+;; here)
+;; (setq lit (c-state-pp-to-literal pos npos))
+;; (setq pos (or (cdr lit) npos)) ; end of literal containing npos.
+;; (setq c-state-nonlit-pos-cache (cons pos c-state-nonlit-pos-cache)))
+
+;; (if (> pos c-state-nonlit-pos-cache-limit)
+;; (setq c-state-nonlit-pos-cache-limit pos))
+;; (if (< pos here)
+;; (setq lit (c-state-pp-to-literal pos here)))
+;; lit))))
+
+
+(defadvice c-state-literal-at (around
+ mumamo-ad-c-state-state-literal-at
+ activate
+ compile
+ )
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (mumamo-c-state-literal-at (ad-get-arg 0))))
+
+
+(defun mumamo-c-state-get-min-scan-pos ()
+ ;; Return the lowest valid scanning pos. This will be the end of the
+ ;; literal enclosing point-min, or point-min itself.
+ (save-restriction
+ (save-excursion
+ (widen)
+ (mumamo-narrow-to-chunk-inner)
+ (or (and c-state-min-scan-pos
+ (>= c-state-min-scan-pos (point-min))
+ c-state-min-scan-pos)
+ (if (not c-state-point-min-lit-start)
+ (goto-char (point-min))
+ (goto-char c-state-point-min-lit-start)
+ (if (eq c-state-point-min-lit-type 'string)
+ (forward-sexp)
+ (forward-comment 1)))
+ (setq c-state-min-scan-pos (point))))))
+
+(defadvice c-state-get-min-scan-pos (around
+ mumamo-ad-c-state-get-min-scan-pos-at
+ activate
+ compile
+ )
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (setq ad-return-value (mumamo-c-state-get-min-scan-pos))))
+
+(eval-after-load 'rng-match
+;;; (defun rng-match-init-buffer ()
+;;; (make-local-variable 'rng-compile-table)
+;;; (make-local-variable 'rng-ipattern-table)
+;;; (make-local-variable 'rng-last-ipattern-index))
+ (progn
+ (put 'rng-compile-table 'permanent-local t)
+ (put 'rng-ipattern-table 'permanent-local t)
+ (put 'rng-last-ipattern-index 'permanent-local t)
+ ))
+
+(eval-after-load 'flyspell
+ (progn
+ (put 'flyspell-mode 'permanent-local t)
+
+ (put 'flyspell-generic-check-word-predicate 'permanent-local t)
+
+ (put 'flyspell-casechars-cache 'permanent-local t)
+ (put 'flyspell-ispell-casechars-cache 'permanent-local t)
+
+ (put 'flyspell-not-casechars-cache 'permanent-local t)
+ (put 'flyspell-ispell-not-casechars-cache 'permanent-local t)
+
+ (put 'flyspell-auto-correct-pos 'permanent-local t)
+ (put 'flyspell-auto-correct-region 'permanent-local t)
+ (put 'flyspell-auto-correct-ring 'permanent-local t)
+ (put 'flyspell-auto-correct-word 'permanent-local t)
+
+ (put 'flyspell-consider-dash-as-word-delimiter-flag 'permanent-local t)
+
+ (put 'flyspell-dash-dictionary 'permanent-local t)
+
+ (put 'flyspell-dash-local-dictionary 'permanent-local t)
+
+ (put 'flyspell-word-cache-start 'permanent-local t)
+ (put 'flyspell-word-cache-end 'permanent-local t)
+ (put 'flyspell-word-cache-word 'permanent-local t)
+ (put 'flyspell-word-cache-result 'permanent-local t)
+
+ (put 'flyspell-word-cache-start 'permanent-local t)
+
+
+ (put 'flyspell-kill-ispell-hook 'permanent-local-hook t)
+ (put 'flyspell-post-command-hook 'permanent-local-hook t)
+ (put 'flyspell-pre-command-hook 'permanent-local-hook t)
+ (put 'flyspell-after-change-function 'permanent-local-hook t)
+ (put 'flyspell-hack-local-variables-hook 'permanent-local-hook t)
+ (put 'flyspell-auto-correct-previous-hook 'permanent-local-hook t)
+
+ (when mumamo-multi-major-mode
+ (when (featurep 'flyspell)
+ (setq flyspell-generic-check-word-predicate 'mumamo-flyspell-verify)))
+ ))
+
+(defun flyspell-mumamo-mode ()
+ "Turn on function `flyspell-mode' for multi major modes."
+ (interactive)
+ (require 'flyspell)
+ (setq flyspell-generic-check-word-predicate 'mumamo-flyspell-verify)
+ (flyspell-mode 1)
+ ;;(run-hooks 'flyspell-prog-mode-hook)
+ )
+
+(eval-after-load 'sgml-mode
+ (progn
+ (put 'sgml-tag-face-alist 'permanent-local t)
+ (put 'sgml-display-text 'permanent-local t)
+ (put 'sgml-tag-alist 'permanent-local t)
+ (put 'sgml-face-tag-alist 'permanent-local t)
+ (put 'sgml-tag-help 'permanent-local t)
+ ))
+
+(eval-after-load 'hl-line
+ (progn
+ (put 'hl-line-overlay 'permanent-local t)
+ ))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; New versions of syntax-ppss functions, temporary written as defadvice.
+
+(defadvice syntax-ppss-flush-cache (around
+ mumamo-ad-syntax-ppss-flush-cache
+ activate
+ compile
+ )
+ "Support for mumamo.
+See the defadvice for `syntax-ppss' for an explanation."
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (let ((pos (ad-get-arg 0)))
+ (let* ((chunk-at-pos (when (and (boundp 'mumamo-multi-major-mode)
+ mumamo-multi-major-mode)
+ (mumamo-find-chunks-1 pos "syntax-ppss-flush-cache"))))
+ (if chunk-at-pos
+ (let* ((syntax-ppss-last (overlay-get chunk-at-pos 'syntax-ppss-last))
+ (syntax-ppss-cache (overlay-get chunk-at-pos 'syntax-ppss-cache)))
+ ;;(setq ad-return-value ad-do-it)
+ ad-do-it
+ (overlay-put chunk-at-pos 'syntax-ppss-last syntax-ppss-last)
+ (overlay-put chunk-at-pos 'syntax-ppss-cache syntax-ppss-cache))
+ ;;(setq ad-return-value ad-do-it)
+ ad-do-it
+ )))))
+
+(defvar mumamo-syntax-chunk-at-pos nil
+ "Internal use.")
+(make-variable-buffer-local 'mumamo-syntax-chunk-at-pos)
+
+;; Fix-me: Is this really needed?
+;; See http://lists.gnu.org/archive/html/emacs-devel/2008-04/msg00374.html
+(defadvice syntax-ppss-stats (around
+ mumamo-ad-syntax-ppss-stats
+ activate
+ compile
+ )
+ "Support for mumamo.
+See the defadvice for `syntax-ppss' for an explanation."
+ (if mumamo-syntax-chunk-at-pos
+ (let* ((syntax-ppss-stats
+ (overlay-get mumamo-syntax-chunk-at-pos 'syntax-ppss-stats)))
+ ad-do-it
+ (overlay-put mumamo-syntax-chunk-at-pos 'syntax-ppss-stats syntax-ppss-stats))
+ ad-do-it))
+
+(defvar mumamo-syntax-ppss-major nil)
+
+;; FIX-ME: There is a problem with " in xhtml files, especially after
+;; syntax="...". Looks like it is the " entry in
+;; `sgml-font-lock-syntactic-keywords' that is jumping in! Dumping
+;; things in `font-lock-apply-syntactic-highlight' seems to show that.
+;;
+;; (I have put in some dump code in my patched version of
+;; Emacs+EmacsW32 there for that. This is commented out by default
+;; and it will only work for the file nxhtml-changes.html which is big
+;; enough for the problem to occur. It happens at point 1109.)
+;;
+;; It is this piece of code where the problem arise:
+;;
+;; (if (prog1
+;; (zerop (car (syntax-ppss (match-beginning 0))))
+;; (goto-char (match-end 0)))
+;; .)
+;;
+;;
+;; It comes from `sgml-font-lock-syntactic-keywords' in sgml-mode.el
+;; and is supposed to protect from " that is not inside a tag.
+;; However in this case for the second " in syntax="..." `syntax-ppss'
+;; returns 0 as the first element in its return value. That happen
+;; even though `major-mode' is correctly `html-mode'. It leads to
+;; that the property 'syntax with the value (1) is added to the "
+;; after the css-mode chunk in syntax="...". The problem persists
+;; even if the chunk has `fundamental-mode' instead of `css-mode'.
+;;
+;; Bypassing the cache for `syntax-pss' by calling
+;; `parse-partial-sexp' directly instead of doing ad-do-it (see
+;; by-pass-chache in the code below) solves the problem for now. It
+;; does not feel like the right solution however.
+;;
+;; One way of temporary solving the problem is perhaps to modify
+;; `mumamo-chunk-attr=' to make "" borders, but I am not sure that it
+;; works and it is the wrong solution.
+(defadvice syntax-ppss (around
+ mumamo-ad-syntax-ppss
+ activate
+ compile
+ )
+ "Support for mumamo chunks.
+For each chunk store as properties of the chunk the parse state
+that is normally hold in `syntax-ppss-last' and
+`syntax-ppss-cache'.
+
+Compute the beginning parse state for a chunk this way:
+
+- If the chunk major mode is the same as the main major mode for
+ the multi major mode then parse from the beginning of the file
+ to the beginning of the chunk using the main major mode. While
+ doing that jump over chunks that do not belong to the main
+ major mode and cache the state at the end and beginning of the
+ the main major mode chunks.
+
+FIX-ME: implement above. Solution?:
+ (parse-partial-sexp syntax-min (1+ syntax-max) nil nil state-at-syntax-min)
+Put this at next chunk's beginning.
+
+- Otherwise set the state at the beginning of the chunk to nil.
+
+Do here also other necessary adjustments for this."
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (let ((pos (ad-get-arg 0)))
+ (unless pos (setq pos (point)))
+ (let* ((chunk-at-pos (when (and (boundp 'mumamo-multi-major-mode) mumamo-multi-major-mode)
+ (mumamo-find-chunks-1 pos "syntax-ppss")))
+ (dump2 (and (boundp 'dump-quote-hunt)
+ dump-quote-hunt
+ (boundp 'start)
+ ;;(= 1109 start)
+ )))
+ ;;(setq dump2 t)
+ (setq mumamo-syntax-chunk-at-pos chunk-at-pos)
+ (when dump2 (msgtrc "\npos=%s point-min=%s mumamo-syntax-ppss.chunk-at-pos=%s" pos (point-min) chunk-at-pos))
+ (if chunk-at-pos
+ (let* ((chunk-syntax-min-max (mumamo-chunk-syntax-min-max chunk-at-pos t))
+ (chunk-syntax-min (car chunk-syntax-min-max))
+ (chunk-major (mumamo-chunk-major-mode chunk-at-pos))
+ (syntax-ppss-last (overlay-get chunk-at-pos 'syntax-ppss-last))
+ (syntax-ppss-cache (overlay-get chunk-at-pos 'syntax-ppss-cache))
+ (syntax-ppss-last-min (overlay-get chunk-at-pos 'syntax-ppss-last-min))
+ (syntax-ppss-cache-min (list syntax-ppss-last-min))
+ ;; This must be fetch the same way as in syntax-ppss:
+ (syntax-begin-function (overlay-get chunk-at-pos 'syntax-begin-function))
+ (syntax-ppss-max-span (if chunk-syntax-min
+ (/ (- pos chunk-syntax-min -2) 2)
+ syntax-ppss-max-span))
+ (syntax-ppss-stats (let ((stats (overlay-get chunk-at-pos 'syntax-ppss-stats)))
+ (if stats
+ stats
+ (default-value 'syntax-ppss-stats))))
+ (last-min-pos (or (car syntax-ppss-last-min)
+ 1))
+ )
+ ;; If chunk has moved the cached values are invalid.
+ (unless (= chunk-syntax-min last-min-pos)
+ (setq syntax-ppss-last nil)
+ (setq syntax-ppss-last-min nil)
+ (setq syntax-ppss-cache nil)
+ (setq syntax-ppss-cache-min nil)
+ (setq syntax-ppss-stats (default-value 'syntax-ppss-stats)))
+ (when dump2
+ (msgtrc " get syntax-ppss-last-min=%s len=%s chunk=%s" syntax-ppss-last-min (length syntax-ppss-last-min) chunk-at-pos)
+ (msgtrc " prop syntax-ppss-last-min=%s" (overlay-properties chunk-at-pos))
+ (msgtrc " chunk-major=%s, %s, syntax-min=%s\n last-min=%s" chunk-major major-mode chunk-syntax-min syntax-ppss-last-min))
+ ;;(setq dump2 nil)
+ (when syntax-ppss-last-min
+ (unless (car syntax-ppss-last-min)
+ ;;(msgtrc "fix-me: emacs bug workaround, setting car of syntax-ppss-last-min")
+ ;;(setcar syntax-ppss-last-min (1- chunk-syntax-min))
+ ;;(msgtrc "fix-me: emacs bug workaround, need new syntax-ppss-last-min because car is nil")
+ (setq syntax-ppss-last-min nil)
+ ))
+ (unless syntax-ppss-last-min
+ (setq syntax-ppss-last nil)
+ (save-restriction
+ (widen)
+ (let* ((min-pos chunk-syntax-min)
+ (chunk-sub-major (mumamo-chunk-major-mode chunk-at-pos))
+ (main-major (mumamo-main-major-mode))
+ (is-main-mode-chunk (mumamo-fun-eq chunk-sub-major main-major)))
+ (when dump2 (msgtrc " min-pos=%s, is-main-mode-chunk=%s" min-pos is-main-mode-chunk))
+ ;; Looks like assert can not be used here for some reason???
+ ;;(assert (and min-pos) t)
+ (unless (and min-pos) (error "defadvice syntax-ppss: (and min-pos=%s)" min-pos))
+ (setq syntax-ppss-last-min
+ (cons min-pos ;;(1- min-pos)
+ (if nil ;is-main-mode-chunk
+ ;; Fix-me: previous chunks as a
+ ;; cache? The problem is updating
+ ;; this. Perhaps it is possible to
+ ;; prune how far back to go by
+ ;; going to the first chunk
+ ;; backwards where
+ ;; (pars-partial-sexp min max) is
+ ;; "nil"?
+ (mumamo-with-major-mode-fontification main-major
+ `(parse-partial-sexp 1 ,min-pos nil nil nil nil))
+ (parse-partial-sexp 1 1))))
+ (setq syntax-ppss-cache-min (list syntax-ppss-last-min))
+ (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))
+ (when dump2 (msgtrc " prop syntax-ppss-last-min=%s" (overlay-properties chunk-at-pos)))
+ (overlay-put chunk-at-pos 'syntax-ppss-last-min syntax-ppss-last-min)
+ (let ((test-syntax-ppss-last-min
+ (overlay-get chunk-at-pos 'syntax-ppss-last-min)))
+ (when dump2 (msgtrc " test syntax-ppss-last-min=%s len=%s" test-syntax-ppss-last-min (length test-syntax-ppss-last-min)))
+ (when dump2 (msgtrc " propt syntax-ppss-last-min=%s" (overlay-properties chunk-at-pos)))
+ ))))
+ (when dump2 (msgtrc " here 0, syntax-ppss-last=%s" syntax-ppss-last))
+ (unless syntax-ppss-last
+ (setq syntax-ppss-last syntax-ppss-last-min)
+ (setq syntax-ppss-cache syntax-ppss-cache-min))
+ ;;(syntax-ppss pos)
+ (when dump2 (msgtrc " at 1, syntax-ppss-last=%s" syntax-ppss-last))
+ (when dump2 (msgtrc " at 1, syntax-ppss-cache=%s" syntax-ppss-cache))
+ (let (ret-val
+ (by-pass-cache t)
+ (dump2 dump2))
+ (if (not by-pass-cache)
+ (progn
+ (when dump2
+ (let ((old-ppss (cdr syntax-ppss-last))
+ (old-pos (car syntax-ppss-last)))
+ ;;(assert (and old-pos pos) t)
+ (unless (and old-pos pos) (error "defadvice syntax-ppss: (and old-pos=%s pos=%s)" old-pos pos))
+ (msgtrc "parse-partial-sexp=>%s" (parse-partial-sexp old-pos pos nil nil old-ppss))))
+ (let (dump2)
+ (setq ret-val ad-do-it)))
+ (let ((old-ppss (cdr syntax-ppss-last))
+ (old-pos (car syntax-ppss-last)))
+ (when dump2
+ (msgtrc "Xparse-partial-sexp %s %s nil nil %s" old-pos pos old-ppss)
+ (let (dump2)
+ (msgtrc "ad-do-it=>%s" ad-do-it)))
+ (save-restriction
+ (widen)
+ ;;(assert (and old-pos pos) t)
+ (unless (and old-pos pos) (error "defadvice syntax-ppss 2 (and old-pos=%s pos=%s)" old-pos pos))
+ (when dump2
+ (msgtrc "parse-partial-sexp %s %s nil nil %s" old-pos pos old-ppss))
+ (setq ret-val (parse-partial-sexp old-pos pos nil nil old-ppss)))))
+ (when dump2 (msgtrc " ==>ret-val=%s" ret-val))
+ ;;(mumamo-backtrace "syntax-ppss")
+ (setq ad-return-value ret-val))
+ (overlay-put chunk-at-pos 'syntax-ppss-last syntax-ppss-last)
+ (overlay-put chunk-at-pos 'syntax-ppss-cache syntax-ppss-cache)
+ (overlay-put chunk-at-pos 'syntax-ppss-stats syntax-ppss-stats)
+ )
+ ad-do-it)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; rng-valid.el support
+
+;; Fix-me: The solution in this defadvice is temporary. The defadvice
+;; for rng-do-some-validation should be fixed instead.
+;; (ad-disable-advice 'rng-mark-error 'around 'mumamo-ad-rng-mark-error)
+;; (ad-ensable-advice 'rng-mark-error 'around 'mumamo-ad-rng-mark-error)
+(defadvice rng-mark-error (around
+ mumamo-ad-rng-mark-error
+ activate
+ compile)
+ "Adjust range for error to chunks."
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (let* ((beg (ad-get-arg 1))
+ (end (ad-get-arg 2))
+ (xml-parts nil)
+ (chunk (mumamo-find-chunks beg "rng-mark-error")))
+ (if (not chunk)
+ ad-do-it
+ (when (and (not (overlay-get chunk 'mumamo-region))
+ (mumamo-valid-nxml-chunk chunk))
+ ;; rng-error
+ (let ((part-beg (max (overlay-start chunk)
+ beg))
+ (part-end (min (overlay-end chunk)
+ end)))
+ (when (< part-beg part-end)
+ (ad-set-arg 1 part-beg)
+ (ad-set-arg 2 part-end)
+ ad-do-it)))))))
+
+(defadvice rng-do-some-validation-1 (around
+ mumamo-ad-rng-do-some-validation-1
+ activate
+ compile)
+ "Adjust validation to chunks."
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ (let (major-mode-chunk
+ (point-max (1+ (buffer-size))) ;(save-restriction (widen) (point-max)))
+ end-major-mode-chunk
+ (limit (+ rng-validate-up-to-date-end
+ rng-validate-chunk-size))
+ (remove-start rng-validate-up-to-date-end)
+ (next-cache-point (+ (point) rng-state-cache-distance))
+ (continue t)
+ (xmltok-dtd rng-dtd)
+ have-remaining-chars
+ xmltok-type
+ xmltok-start
+ xmltok-name-colon
+ xmltok-name-end
+ xmltok-replacement
+ xmltok-attributes
+ xmltok-namespace-attributes
+ xmltok-dependent-regions
+ xmltok-errors
+ (while-n1 0)
+ (while-n2 0)
+ (old-point -1)
+ )
+ ;;(msgtrc "> > > > > enter rng-do-some-validation-1, continue-p-function=%s" continue-p-function)
+ (setq have-remaining-chars (< (point) point-max))
+ (when (and continue (= (point) 1))
+ (let ((regions (xmltok-forward-prolog)))
+ (rng-clear-overlays 1 (point))
+ (while regions
+ (when (eq (aref (car regions) 0) 'encoding-name)
+ (rng-process-encoding-name (aref (car regions) 1)
+ (aref (car regions) 2)))
+ (setq regions (cdr regions))))
+ (unless (equal rng-dtd xmltok-dtd)
+ (rng-clear-conditional-region))
+ (setq rng-dtd xmltok-dtd))
+ (setq while-n1 0)
+ (while (and (mumamo-while 2000 'while-n1 "continue")
+ (/= old-point (point))
+ continue)
+ (setq old-point (point))
+ ;; If mumamo (or something similar) is used then jump over parts
+ ;; that can not be parsed by nxml-mode.
+ (when (and rng-get-major-mode-chunk-function
+ rng-valid-nxml-major-mode-chunk-function
+ rng-end-major-mode-chunk-function)
+ (let ((here (point))
+ next-non-space-pos)
+ (skip-chars-forward " \t\r\n")
+ (setq next-non-space-pos (point))
+ (goto-char here)
+ (unless (and end-major-mode-chunk
+ ;; Remaining chars in this chunk?
+ (< next-non-space-pos end-major-mode-chunk))
+ (setq end-major-mode-chunk nil)
+ (setq major-mode-chunk (funcall rng-get-major-mode-chunk-function next-non-space-pos "rng-do-some-validation-1 A"))
+ (setq while-n2 0)
+ (while (and (mumamo-while 500 'while-n2 "major-mode-chunk")
+ major-mode-chunk
+ (not (funcall rng-valid-nxml-major-mode-chunk-function major-mode-chunk))
+ (< next-non-space-pos (point-max)))
+ ;;(msgtrc "next-non-space-pos=%s, cb=%s" next-non-space-pos (current-buffer))
+ (let ((end-pos (funcall rng-end-major-mode-chunk-function major-mode-chunk)))
+ ;; fix-me: The problem here is that
+ ;; mumamo-find-chunks can return a 0-length chunk.
+ ;;(goto-char (+ end-pos 0))
+ (goto-char (+ end-pos (if (= end-pos (point)) 1 0)))
+ (setq major-mode-chunk (funcall rng-get-major-mode-chunk-function (point) "rng-do-some-validation-1 B"))
+ ;;(message "---> here 3, point=%s, ep=%s, mm-chunk=%s" (point) end-pos major-mode-chunk)
+ )
+ (setq next-non-space-pos (point))))
+ ;; Stop parsing if we do not have a chunk here yet.
+ ;;(message "major-mode-chunk=%s" major-mode-chunk)
+ ;;(message "rng-valid-nxml-major-mode-chunk-function=%s" rng-valid-nxml-major-mode-chunk-function)
+ (setq continue (and major-mode-chunk
+ (funcall rng-valid-nxml-major-mode-chunk-function major-mode-chunk)))
+ ;;(unless continue (message "continue=nil, no major-mode-chunk"))
+ (when continue
+ ;;(message " continue=t")
+ (setq end-major-mode-chunk (funcall rng-end-major-mode-chunk-function major-mode-chunk)))))
+
+ (when continue
+ ;; Narrow since rng-forward will continue into next chunk
+ ;; even if limit is at chunk end.
+ (if t
+ (progn
+ ;;(message "before rng-forward, point=%s" (point))
+ (setq have-remaining-chars (rng-forward end-major-mode-chunk))
+ ;;(message "after rng-forward, point=%s" (point))
+ )
+ ;; Fix-me: Validation does not work when narrowing because
+ ;; some state variables values seems to be lost. Probably
+ ;; looking at `rng-validate-prepare' will tell what to do.
+ (save-restriction
+ (when (and end-major-mode-chunk
+ (< (point-min) end-major-mode-chunk))
+ (narrow-to-region (point-min) end-major-mode-chunk))
+ (setq have-remaining-chars (rng-forward end-major-mode-chunk)))
+ (unless (> end-major-mode-chunk (point))
+ ;;(setq have-remaining-chars t)
+ (goto-char end-major-mode-chunk))
+ )
+ ;;(message "end-major-mode-chunk=%s, rng-validate-up-to-date-end=%s" end-major-mode-chunk rng-validate-up-to-date-end)
+ (setq have-remaining-chars (< (point) point-max))
+ ;;(unless have-remaining-chars (message "*** here have-remaining-chars=%s, p=%s/%s" have-remaining-chars (point) point-max))
+ (let ((pos (point)))
+ (when end-major-mode-chunk
+ ;; Fix-me: Seems like we need a new initialization (or why
+ ;; do we otherwise hang without this?)
+ (and (> limit end-major-mode-chunk) (setq limit end-major-mode-chunk)))
+ (setq continue
+ (and have-remaining-chars
+ continue
+ (or (< pos limit)
+ (and continue-p-function
+ (funcall continue-p-function)
+ (setq limit (+ limit rng-validate-chunk-size))
+ t))))
+ ;;(unless continue (message "continue=nil, why?: %s<%s, %s" pos limit (when continue-p-function (funcall continue-p-function))))
+ (cond ((and rng-conditional-up-to-date-start
+ ;; > because we are getting the state from (1- pos)
+ (> pos rng-conditional-up-to-date-start)
+ (< pos rng-conditional-up-to-date-end)
+ (rng-state-matches-current (get-text-property (1- pos)
+ 'rng-state)))
+ (when (< remove-start (1- pos))
+ (rng-clear-cached-state remove-start (1- pos)))
+ ;; sync up with cached validation state
+ (setq continue nil)
+ ;; do this before settting rng-validate-up-to-date-end
+ ;; in case we get a quit
+ (rng-mark-xmltok-errors)
+ (rng-mark-xmltok-dependent-regions)
+ (setq rng-validate-up-to-date-end
+ (marker-position rng-conditional-up-to-date-end))
+ (rng-clear-conditional-region)
+ (setq have-remaining-chars
+ (< rng-validate-up-to-date-end point-max))
+ ;;(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))
+ )
+ ((or (>= pos next-cache-point)
+ (not continue))
+ (setq next-cache-point (+ pos rng-state-cache-distance))
+ (rng-clear-cached-state remove-start pos)
+ (when have-remaining-chars
+ ;;(message "rng-cach-state (1- %s)" pos)
+ (rng-cache-state (1- pos)))
+ (setq remove-start pos)
+ (unless continue
+ ;; if we have just blank chars skip to the end
+ (when have-remaining-chars
+ (skip-chars-forward " \t\r\n")
+ (when (= (point) point-max)
+ (rng-clear-overlays pos (point))
+ (rng-clear-cached-state pos (point))
+ (setq have-remaining-chars nil)
+ ;;(message "have-remaining-chars => nil, cause (point) = point-max")
+ (setq pos (point))))
+ (when (not have-remaining-chars)
+ (rng-process-end-document))
+ (rng-mark-xmltok-errors)
+ (rng-mark-xmltok-dependent-regions)
+ (setq rng-validate-up-to-date-end pos)
+ (when rng-conditional-up-to-date-end
+ (cond ((<= rng-conditional-up-to-date-end pos)
+ (rng-clear-conditional-region))
+ ((< rng-conditional-up-to-date-start pos)
+ (set-marker rng-conditional-up-to-date-start
+ pos))))))))))
+ ;;(message "--- exit rng-do-some-validation-1, have-remaining-chars=%s" have-remaining-chars)
+ (setq have-remaining-chars (< (point) point-max))
+ (setq ad-return-value have-remaining-chars))))
+
+(defadvice rng-after-change-function (around
+ mumamo-ad-rng-after-change-function
+ activate
+ compile)
+ (when rng-validate-up-to-date-end
+ ad-do-it))
+
+(defadvice rng-validate-while-idle (around
+ mumamo-ad-rng-validate-while-idle
+ activate
+ compile)
+ (if (not (buffer-live-p buffer))
+ (rng-kill-timers)
+ ad-do-it))
+
+(defadvice rng-validate-quick-while-idle (around
+ mumamo-ad-rng-validate-quick-while-idle
+ activate
+ compile)
+ (if (not (buffer-live-p buffer))
+ (rng-kill-timers)
+ ad-do-it))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; xmltok.el
+
+;; (ad-disable-advice 'xmltok-add-error 'around 'mumamo-ad-xmltok-add-error)
+;; (ad-ensable-advice 'xmltok-add-error 'around 'mumamo-ad-xmltok-add-error)
+(defadvice xmltok-add-error (around
+ mumamo-ad-xmltok-add-error
+ activate
+ compile
+ )
+ "Prevent rng validation errors in non-xml chunks.
+This advice only prevents adding nxml/rng-valid errors in non-xml
+chunks. Doing more seems like a very big job - unless Emacs gets
+a narrow-to-multiple-regions function!"
+ (if (not mumamo-multi-major-mode)
+ ad-do-it
+ ;;(error "xmltok-add-error: %S" (with-output-to-string (backtrace)))
+ (when (let* ((start (or start xmltok-start))
+ (end (or end (point)))
+ (chunk (mumamo-find-chunks (if start start end) "xmltok-add-error"))
+ )
+ (or (not chunk)
+ (and (not (overlay-get chunk 'mumamo-region))
+ (mumamo-valid-nxml-chunk chunk))))
+ (setq xmltok-errors
+ (cons (xmltok-make-error message
+ (or start xmltok-start)
+ (or end (point)))
+ xmltok-errors)))))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Maybe activate advices
+
+;; Fix-me: This assumes there are no other advices on these functions.
+(if t
+ (progn
+ ;; (ad-activate 'syntax-ppss)
+ ;; (ad-activate 'syntax-ppss-flush-cache)
+ ;; (ad-activate 'syntax-ppss-stats)
+ ;; (ad-activate 'rng-do-some-validation-1)
+ ;; (ad-activate 'rng-mark-error)
+ ;; (ad-activate 'xmltok-add-error)
+ (ad-enable-advice 'syntax-ppss 'around 'mumamo-ad-syntax-ppss)
+ (ad-enable-advice 'syntax-ppss-flush-cache 'around 'mumamo-ad-syntax-ppss-flush-cache)
+ (ad-enable-advice 'syntax-ppss-stats 'around 'mumamo-ad-syntax-ppss-stats)
+ (ad-enable-advice 'rng-do-some-validation-1 'around 'mumamo-ad-rng-do-some-validation-1)
+ (ad-enable-advice 'rng-mark-error 'around 'mumamo-ad-rng-mark-error)
+ (ad-enable-advice 'rng-after-change-function 'around 'mumamo-ad-rng-after-change-function)
+ (ad-enable-advice 'rng-validate-while-idle 'around 'mumamo-ad-rng-validate-while-idle)
+ (ad-enable-advice 'rng-validate-quick-while-idle 'around 'mumamo-ad-rng-validate-quick-while-idle)
+ (ad-enable-advice 'xmltok-add-error 'around 'mumamo-ad-xmltok-add-error)
+ )
+ ;; (ad-deactivate 'syntax-ppss)
+ ;; (ad-deactivate 'syntax-ppss-flush-cache)
+ ;; (ad-deactivate 'syntax-ppss-stats)
+ ;; (ad-deactivate 'rng-do-some-validation-1)
+ ;; (ad-deactivate 'rng-mark-error)
+ ;; (ad-deactivate 'xmltok-add-error)
+ (ad-disable-advice 'syntax-ppss 'around 'mumamo-ad-syntax-ppss)
+ (ad-disable-advice 'syntax-ppss-flush-cache 'around 'mumamo-ad-syntax-ppss-flush-cache)
+ (ad-disable-advice 'syntax-ppss-stats 'around 'mumamo-ad-syntax-ppss-stats)
+ (ad-disable-advice 'rng-do-some-validation-1 'around 'mumamo-ad-rng-do-some-validation-1)
+ (ad-disable-advice 'rng-mark-error 'around 'mumamo-ad-rng-mark-error)
+ (ad-disable-advice 'rng-after-change-function 'around 'mumamo-ad-rng-after-change-function)
+ (ad-disable-advice 'rng-validate-while-idle 'around 'mumamo-ad-rng-validate-while-idle)
+ (ad-disable-advice 'rng-validate-quick-while-idle 'around 'mumamo-ad-rng-validate-quick-while-idle)
+ (ad-disable-advice 'xmltok-add-error 'around 'mumamo-ad-xmltok-add-error)
+ )
+
+(font-lock-add-keywords
+ 'emacs-lisp-mode
+ '(("\\" . font-lock-keyword-face)))
+
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Simple defadvice to move into Emacs later
+
+(defun mumamo-ad-desktop-buffer-info (buffer)
+ (set-buffer buffer)
+ (list
+ ;; base name of the buffer; replaces the buffer name if managed by uniquify
+ (and (fboundp 'uniquify-buffer-base-name) (uniquify-buffer-base-name))
+ ;; basic information
+ (desktop-file-name (buffer-file-name) desktop-dirname)
+ (buffer-name)
+ (if mumamo-multi-major-mode mumamo-multi-major-mode major-mode)
+ ;; minor modes
+ (let (ret)
+ (mapc
+ #'(lambda (minor-mode)
+ (and (boundp minor-mode)
+ (symbol-value minor-mode)
+ (let* ((special (assq minor-mode desktop-minor-mode-table))
+ (value (cond (special (cadr special))
+ ((functionp minor-mode) minor-mode))))
+ (when value (add-to-list 'ret value)))))
+ (mapcar #'car minor-mode-alist))
+ ret)
+ ;; point and mark, and read-only status
+ (point)
+ (list (mark t) mark-active)
+ buffer-read-only
+ ;; auxiliary information
+ (when (functionp desktop-save-buffer)
+ (funcall desktop-save-buffer desktop-dirname))
+ ;; local variables
+ (let ((locals desktop-locals-to-save)
+ (loclist (buffer-local-variables))
+ (ll))
+ (while locals
+ (let ((here (assq (car locals) loclist)))
+ (if here
+ (setq ll (cons here ll))
+ (when (member (car locals) loclist)
+ (setq ll (cons (car locals) ll)))))
+ (setq locals (cdr locals)))
+ ll)))
+
+(defadvice desktop-buffer-info (around
+ mumamo-ad-desktop-buffer-info
+ activate
+ compile)
+ (setq ad-return-value (mumamo-ad-desktop-buffer-info (ad-get-arg 0))))
+
+(defun mumamo-ad-set-auto-mode-0 (mode &optional keep-mode-if-same)
+ "Apply MODE and return it.
+If optional arg KEEP-MODE-IF-SAME is non-nil, MODE is chased of
+any aliases and compared to current major mode. If they are the
+same, do nothing and return nil."
+ (unless (and keep-mode-if-same
+ (eq (indirect-function mode)
+ (if mumamo-multi-major-mode
+ (indirect-function mumamo-multi-major-mode)
+ (indirect-function major-mode))))
+ (when mode
+ (funcall mode)
+ mode)))
+
+(defadvice set-auto-mode-0 (around
+ mumamo-ad-set-auto-mode-0
+ activate
+ compile)
+ (setq ad-return-value (mumamo-ad-set-auto-mode-0 (ad-get-arg 0)
+ (ad-get-arg 1)
+ )))
+
+
+
+(defvar mumamo-sgml-get-context-last-close nil
+ "Last close tag start.
+Only used for outermost level.")
+
+(defun mumamo-sgml-get-context (&optional until)
+ "Determine the context of the current position.
+By default, parse until we find a start-tag as the first thing on a line.
+If UNTIL is `empty', return even if the context is empty (i.e.
+we just skipped over some element and got to a beginning of line).
+
+The context is a list of tag-info structures. The last one is the tag
+immediately enclosing the current position.
+
+Point is assumed to be outside of any tag. If we discover that it's
+not the case, the first tag returned is the one inside which we are."
+ (let ((here (point))
+ (stack nil)
+ (ignore nil)
+ (context nil)
+ tag-info
+ last-close)
+ ;; CONTEXT keeps track of the tag-stack
+ ;; STACK keeps track of the end tags we've seen (and thus the start-tags
+ ;; we'll have to ignore) when skipping over matching open..close pairs.
+ ;; IGNORE is a list of tags that can be ignored because they have been
+ ;; closed implicitly.
+ ;; LAST-CLOSE is last close tag that can be useful for indentation
+ ;; when on outermost level.
+ (skip-chars-backward " \t\n") ; Make sure we're not at indentation.
+ (while
+ (and (not (eq until 'now))
+ (or stack
+ (not (if until (eq until 'empty) context))
+ (not (sgml-at-indentation-p))
+ (and context
+ (/= (point) (sgml-tag-start (car context)))
+ (sgml-unclosed-tag-p (sgml-tag-name (car context)))))
+ (setq tag-info (ignore-errors (sgml-parse-tag-backward))))
+
+ ;; This tag may enclose things we thought were tags. If so,
+ ;; discard them.
+ (while (and context
+ (> (sgml-tag-end tag-info)
+ (sgml-tag-end (car context))))
+ (setq context (cdr context)))
+
+ (cond
+ ((> (sgml-tag-end tag-info) here)
+ ;; Oops!! Looks like we were not outside of any tag, after all.
+ (push tag-info context)
+ (setq until 'now))
+
+ ;; start-tag
+ ((eq (sgml-tag-type tag-info) 'open)
+ (when (and (null stack)
+ last-close)
+ (setq last-close 'no-use))
+ (cond
+ ((null stack)
+ (if (assoc-string (sgml-tag-name tag-info) ignore t)
+ ;; There was an implicit end-tag.
+ nil
+ (push tag-info context)
+ ;; We're changing context so the tags implicitly closed inside
+ ;; the previous context aren't implicitly closed here any more.
+ ;; [ Well, actually it depends, but we don't have the info about
+ ;; when it doesn't and when it does. --Stef ]
+ (setq ignore nil)))
+ ((eq t (compare-strings (sgml-tag-name tag-info) nil nil
+ (car stack) nil nil t))
+ (setq stack (cdr stack)))
+ (t
+ ;; The open and close tags don't match.
+ (if (not sgml-xml-mode)
+ (unless (sgml-unclosed-tag-p (sgml-tag-name tag-info))
+ (message "Unclosed tag <%s>" (sgml-tag-name tag-info))
+ (let ((tmp stack))
+ ;; We could just assume that the tag is simply not closed
+ ;; but it's a bad assumption when tags *are* closed but
+ ;; not properly nested.
+ (while (and (cdr tmp)
+ (not (eq t (compare-strings
+ (sgml-tag-name tag-info) nil nil
+ (cadr tmp) nil nil t))))
+ (setq tmp (cdr tmp)))
+ (if (cdr tmp) (setcdr tmp (cddr tmp)))))
+ (message "Unmatched tags <%s> and "
+ (sgml-tag-name tag-info) (pop stack)))))
+
+ (if (and (null stack) (sgml-unclosed-tag-p (sgml-tag-name tag-info)))
+ ;; This is a top-level open of an implicitly closed tag, so any
+ ;; occurrence of such an open tag at the same level can be ignored
+ ;; because it's been implicitly closed.
+ (push (sgml-tag-name tag-info) ignore)))
+
+ ;; end-tag
+ ((eq (sgml-tag-type tag-info) 'close)
+ (if (sgml-empty-tag-p (sgml-tag-name tag-info))
+ (message "Spurious : empty tag" (sgml-tag-name tag-info))
+ ;; Keep track of last close if context will return nil
+ (when (and (not last-close)
+ (null stack)
+ (> here (point-at-eol))
+ (let ((here (point)))
+ (goto-char (sgml-tag-start tag-info))
+ (skip-chars-backward " \t")
+ (prog1
+ (bolp)
+ (goto-char here))))
+ (setq last-close tag-info))
+
+ (push (sgml-tag-name tag-info) stack)))
+ ))
+
+ ;; return context
+ (setq mumamo-sgml-get-context-last-close
+ (when (and last-close
+ (not (eq last-close 'no-use)))
+ (sgml-tag-start last-close)))
+ context))
+
+(defadvice sgml-get-context (around
+ mumamo-ad-sgml-get-context
+ activate
+ compile)
+ (setq ad-return-value (mumamo-sgml-get-context (ad-get-arg 0))))
+
+(defun mumamo-sgml-calculate-indent (&optional lcon)
+ "Calculate the column to which this line should be indented.
+LCON is the lexical context, if any."
+ (unless lcon (setq lcon (sgml-lexical-context)))
+
+ ;; Indent comment-start markers inside