;;; 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