diff options
Diffstat (limited to 'emacs.d/nxhtml/util/mumamo.el')
| -rw-r--r-- | emacs.d/nxhtml/util/mumamo.el | 9101 |
1 files changed, 0 insertions, 9101 deletions
diff --git a/emacs.d/nxhtml/util/mumamo.el b/emacs.d/nxhtml/util/mumamo.el deleted file mode 100644 index c59300f..0000000 --- a/emacs.d/nxhtml/util/mumamo.el +++ /dev/null @@ -1,9101 +0,0 @@ -;;; 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 - syntax-begin-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 'syntax-begin-function (custom-quote syntax-begin-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 'syntax-begin-function) - syntax-begin-function) - syntax-begin-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 </script> 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? -;; -;; <?php header("Content-type:application/xml; charset=utf-8"); echo '<?xml version="1.0" encoding="utf-8"?>'; ?> -;; -;; However there are the reverse cases also, in lines like -;; -;; href="<?php $this->url($url); ?>" -;; <!-- <td><?php insert_a_lot_of_html(); ?> -;; -;; These are supposedly handled by using this test at the right -;; place... However it is not very clear in all cases whether chunk -;; dividers in comments and strings should be valid or not... -;; -;; For example in the first case above the php divider should be -;; valid. Probably it should be that in the second case too, but how -;; should mumamo know that? -;; -;; Fix-me: I think a per "chunk divider function + context" flag is -;; needed to handle this. Probably this will work the same for all web -;; dev things, ie the opening sub chunk divider is ALWAYS -;; valid. However that is not true for things like CSS, Javascript etc -;; in (X)HTML. - -(defun mumamo-end-in-code (syntax-start syntax-end major) - "Return t if possible syntax end is not in a string or comment. -Assume that the sexp syntax is nil at SYNTAX-START return t if -position SYNTAX-END is not in a string or comment according to -the sexp syntax using major mode MAJOR." - ;; Fix-me: This can't always detect html comments: <!-- - ;; ... -->. 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 <style> /* comment */ -;; fix-me: clean up -(put 'mumamo-error-ind-0 'error-conditions '(error mumamo-error-ind-0)) -(put 'mumamo-error-ind-0 'error-message "indentation 0 in sub chunk") - - - -;;;;;;;;;;;;;;;;;;;;;;;; -;; Template indentation -;;; Contact Marc Bowes when I've finished this. - -(defvar mumamo-template-indent-buffer nil) -(make-variable-buffer-local 'mumamo-template-indent-buffer) -(put 'mumamo-template-indent-buffer 'permanent-local t) - -(defvar mumamo-template-indent-change-min nil) -(make-variable-buffer-local 'mumamo-template-indent-change-min) -(put 'mumamo-template-indent-hange-min 'permanent-local t) - -(defun mumamo-template-indent-after-change (beg end len) - (setq mumamo-template-indent-change-min - (if mumamo-template-indent-change-min - (min mumamo-template-indent-change-min beg) - beg))) - -;; (defun mumamo-get-indentor-create (indentor-chunk prev-indentor) -;; (let ((indentor (overlay-get indentor-chunk 'mumamo-indentor)) -;; (indentor-buffer (when indentor (overlay-buffer indentor))) -;; (chunk-str (with-current-buffer (overlay-buffer indentor-chunk) -;; (buffer-substring-no-properties (overlay-start indentor-chunk) -;; (overlay-end indentor-chunk)))) -;; ) -;; (unless (and indentor -;; (eq indentor-buffer mumamo-template-indent-buffer) -;; (string= chunk-str (overlay-get indentor 'indentor-chunk-string))) -;; (when indentor -;; (when (buffer-live-p -;; indentor -;; )) -(defun mumamo-indentor-valid (indentor chunk chunk-string) - (and indentor - chunk - (buffer-live-p (overlay-buffer chunk)) - (string= chunk-string (overlay-get indentor 'indentor-chunk-string)) - )) - -(defun mumamo-template-indent-get-chunk-shift (indentor-chunk) - "Return indentation shift for INDENTOR-CHUNK row and line after. -;; Fix-me: Handle changes better. - -Indentation shift has two parts: shift for current line and for next line. -This function returns a cons with these two parts. -" - (assert (overlayp indentor-chunk) t) - (assert (buffer-live-p (overlay-buffer indentor-chunk)) t) - (let ((indentor (overlay-get indentor-chunk 'mumamo-indentor)) - (prev-chunk (overlay-get indentor-chunk 'mumamo-prev-chunk)) - prev-indentor prev-indentor-chunk) - (when indentor (assert (eq indentor-chunk (overlay-get indentor 'indentor-chunk)) t)) - (unless (and mumamo-template-indent-buffer - (buffer-live-p mumamo-template-indent-buffer)) - (setq indentor nil) - (setq mumamo-template-indent-buffer - (get-buffer-create (concat (buffer-name) - "-template-indent-buffer"))) - (with-current-buffer mumamo-template-indent-buffer - (setq buffer-undo-list t) - (let ((major (car (overlay-get indentor-chunk 'mumamo-major-mode)))) - (funcall major)))) - (when indentor - (unless (eq (overlay-buffer indentor) mumamo-template-indent-buffer) - (setq indentor nil))) - ;; We need the prev indentor to indent relative to. - (while (and prev-chunk (not prev-indentor-chunk)) - (setq prev-chunk (overlay-get prev-chunk 'mumamo-prev-chunk)) - (when prev-chunk - (when (eq (overlay-get prev-chunk 'mumamo-next-indent) - 'mumamo-template-indentor) - (setq prev-indentor-chunk (overlay-get prev-chunk 'mumamo-next-chunk))))) - (when prev-indentor-chunk - (setq prev-indentor (overlay-get prev-indentor-chunk 'mumamo-indentor))) - (when prev-indentor - (unless (buffer-live-p (overlay-buffer prev-indentor)) - (setq prev-indentor nil))) - (when prev-indentor (assert (eq (overlay-buffer prev-indentor) mumamo-template-indent-buffer) t)) - (with-current-buffer mumamo-template-indent-buffer - (save-restriction - (widen) - ;; Insert a blank line to be able to go to start of first - ;; overlay -1. Do it here in case the user erases the buffer. - (when (= 0 (buffer-size)) (insert "\n")) - (let ((i-str (when indentor - (buffer-substring-no-properties (overlay-start indentor) (overlay-end indentor)))) - (i-beg (when indentor (overlay-start indentor))) - (c-str (with-current-buffer (overlay-buffer indentor-chunk) - (buffer-substring-no-properties (overlay-start indentor-chunk) - (overlay-end indentor-chunk)))) - (p-str (when prev-indentor-chunk - (with-current-buffer (overlay-buffer prev-indentor-chunk) - (buffer-substring-no-properties (overlay-start prev-indentor-chunk) - (overlay-end prev-indentor-chunk))))) - (c-beg (overlay-start indentor-chunk)) - (p-beg (when prev-indentor-chunk (overlay-start prev-indentor-chunk)))) - ;; Check if `indentor' and `prev-indentor' are valid - (when indentor - ;;(unless (string= c-str (overlay-get indentor 'indentor-chunk-string)) - (unless (mumamo-indentor-valid indentor indentor-chunk c-str) - (mumamo-remove-indentor indentor))) - (when prev-indentor - ;;(unless (string= p-str (overlay-get prev-indentor 'indentor-chunk-string)) - (unless (mumamo-indentor-valid prev-indentor prev-indentor-chunk p-str) - (mumamo-remove-indentor prev-indentor))) - (unless indentor - (setq i-beg - (or i-beg - (when prev-indentor - ;; We just put `indentor' after this, but we - ;; must also remove old stuff. - (goto-char (overlay-end prev-indentor)) - (forward-char 1) - (let* ((next-indentor (mumamo-indentor-at (point))) - (next-indentor-chunk (when next-indentor - (overlay-get next-indentor 'indentor-chunk))) - n-beg - (new-i-beg (unless next-indentor-chunk (point)))) - (while (not new-i-beg) - (setq n-beg (when (buffer-live-p (overlay-buffer next-indentor-chunk)) - (overlay-start next-indentor-chunk))) - (if (or (not n-beg) (< n-beg c-beg)) - (progn - (mumamo-remove-indentor next-indentor) - (goto-char (overlay-end prev-indentor)) - (forward-char 1) - (setq next-indentor (mumamo-indentor-at (point))) - (if next-indentor - (setq next-indentor-chunk (overlay-get next-indentor 'indentor-chunk)) - (setq new-i-beg (point)))) - (setq new-i-beg (point)))) - new-i-beg)) - ;; Fix-me: Find out where to insert indentor: - (let* ((ll 1) - (rr (point-max)) - mm new-i-beg m-ovl m-ovl-old m-chunk m-beg) - (while (< ll rr) - (setq mm (+ ll (/ (- rr ll) 2))) - (setq m-ovl-old m-ovl) - (setq m-ovl (mumamo-indentor-at mm)) - (if (or (not m-ovl) (eq m-ovl m-ovl-old)) - (setq rr ll) - (setq m-chunk (overlay-get m-ovl 'indentor-chunk)) - (setq m-beg (when (buffer-live-p (overlay-buffer m-chunk)) - (overlay-start m-chunk))) - (cond ((not m-beg) - (mumamo-remove-indentor m-ovl) - (setq rr (min rr (point-max)))) - ((> m-beg c-beg) - (setq ll (1+ mm))) - ((< m-beg c-beg) - (setq rr (1- mm))) - (t (error "Found old indentor at %s belonging to %S" mm m-chunk))))) - ;;(1+ (if m-ovl (overlay-end m-ovl) 0)) - (if m-ovl (1+ (overlay-end m-ovl)) 2) - ))) - (goto-char i-beg) - (setq indentor (mumamo-make-indentor indentor-chunk c-str))) - (unless prev-indentor - (when prev-indentor-chunk - (goto-char (overlay-start indentor)) - (goto-char (point-at-bol)) - (setq prev-indentor (mumamo-make-indentor prev-indentor-chunk p-str)))) - (when prev-indentor (mumamo-indent-indentor prev-indentor)) - (mumamo-indent-indentor indentor) - (let (prev-ind this-ind next-ind shift-in shift-out) - (when prev-indentor - (goto-char (overlay-end prev-indentor)) - (setq prev-ind (current-indentation))) - (goto-char (overlay-start indentor)) - (setq this-ind (current-indentation)) - (goto-char (overlay-end indentor)) - (setq next-ind (current-indentation)) - (when prev-ind (setq shift-in (- this-ind prev-ind))) - (setq shift-out (- next-ind this-ind)) - (msgtrc "template-indent-get-shunk-shift => (%s . %s)" shift-in shift-out) - (cons shift-in shift-out))))))) - - -(defun mumamo-ruby-beginning-of-indent () - "TODO: document" - ;; I don't understand this function. - ;; It seems like it should move to the line where indentation should deepen, - ;; but ruby-indent-beg-re only accounts for whitespace before class, module and def, - ;; so this will only match other block beginners at the beginning of the line. - (and - (prog1 - (re-search-backward (concat "^\\(" ruby-indent-beg-re "\\)\\b") nil 'move) - (skip-chars-forward " \t\n\r")) - (beginning-of-line))) - -(defadvice ruby-beginning-of-indent (around - mumamo-ad-ruby-beginning-of-indent - activate - compile - ) - (if t - (mumamo-ruby-beginning-of-indent) - ad-do-it) - ) - -(defun mumamo-indentor-at (pos) - "Return indentor overlay at POS." - (let ((here (point)) - eol-pos) - (goto-char pos) - (setq eol-pos (line-end-position)) - (goto-char here) - (catch 'ind - (dolist (ovl (or (overlays-at eol-pos) - (when (> eol-pos 1) - (overlays-at (1- eol-pos))))) - (when (overlay-get ovl 'indentor-chunk) - (throw 'ind ovl)))))) - -(defun mumamo-remove-indentor (indentor) - (let (beg end) - (goto-char (overlay-start indentor)) - (setq beg (point-at-bol)) - (goto-char (overlay-end indentor)) - (setq end (1+ (point-at-eol))) - (delete-region beg end) - (delete-overlay indentor) - (setq indentor nil))) - -(defun mumamo-indent-indentor (indentor) - (goto-char (overlay-start indentor)) - (if (= 2 (point-at-bol)) - (progn - (back-to-indentation) - (delete-region 2 (point)) - (insert " ")) - (indent-according-to-mode)) - (goto-char (overlay-end indentor)) - (indent-according-to-mode)) - -(defun mumamo-make-indentor (indentor-chunk chunk-string) - (let* ((beg (point)) - (syntax-min-max (mumamo-chunk-syntax-min-max indentor-chunk t)) - (inner (with-current-buffer (overlay-buffer indentor-chunk) - (buffer-substring-no-properties (cdr syntax-min-max) - (car syntax-min-max)))) - indentor) - (insert inner) - (insert "\n\n") - (setq indentor (make-overlay beg (1- (point)) nil t t)) - (overlay-put indentor 'indentor-chunk indentor-chunk) - (overlay-put indentor 'face 'secondary-selection) - (overlay-put indentor 'indentor-chunk-string chunk-string) - (overlay-put indentor-chunk 'mumamo-indentor indentor) - indentor)) - -;;(mumamo-fun-eq 'js-mode 'javascript-mode) -(defun mumamo-fun-eq (fun1 fun2) - "Return non-nil if same functions or aliases." - (or (eq fun1 fun2) - (progn - (while (and (fboundp fun1) - (symbolp (symbol-function fun1))) - (setq fun1 (symbol-function fun1))) - (while (and (fboundp fun2) - (symbolp (symbol-function fun2))) - (setq fun2 (symbol-function fun2))) - (eq fun1 fun2)))) - -(defun mumamo-indent-line-function-1 (prev-line-chunks - last-parent-major-indent - entering-submode-arg) - ;; Fix-me: error indenting in xml-as-string at <?\n?> - ;; Fix-me: clean up, use depth diff. go back to sibling not to main etc. - ;; Fix-me: Add indentation hints to chunks, for example heredocs and rhtml. - ;; Fix-me: maybe use special indentation functions for certain multi major modes? rhtml? - "Indent current line. -When doing that care must be taken if this line's major modes at -the start and end are different from previous line major modes. -The latter may be known through the parameter PREV-LINE-CHUNKS. - -Also the indentation of the last previous main major line may be -necessary to know. This may be known through the parameter -LAST-PARENT-MAJOR-INDENT. - -If the two parameters above are nil then this function will -search backwards in the buffer to try to determine their values. - -The following rules are used when indenting: - -- If the major modes are the same in this and the previous line - then indentation is done using that major mode. - -- Exception: If the chunks are not the same AND there is - precisely one chunk between them which have the property value - of 'mumamo-next-indent equal to 'mumamo-template-indentor then - a special indent using the content of the middle chunk is - done. An example of this is eRuby where a middle chunk could - look like: - - <% 3.times do %> - - This example will increase indentation for the next line the - same way as the chunk content would do in single major mode - ruby-mode. - - FIXE-ME: IMPLEMENT THE ABOVE! - -- Otherwise if going into a submode indentation is increased by - `mumamo-submode-indent-offset' (if this is nil then indentation - will instead be 0). - -- However first non-empty line indentation in a chunk when going - in is special if prev-prev chunk is on same mumamo-depth and - have the same major mode. Then indent relative last non-empty - line in prev-prev chunk. - -- When going out of a submode indentation is reset to - LAST-PARENT-MAJOR-INDENT. - -- At the border the 'dividers' should be indented as the parent - chunk. There are the following typical situations regarding - inner/outer major modes: - - 1) <style type='text/css'> - Going in next line; first char outer; line end inner; - - 2) </style> - Going out this line; First char inner or outer; line end outer; - - 3) <?php - Going in next line; first char outer or inner; line end inner; - - 4) ?> - 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 - '(("\\<define-mumamo-multi-major-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 </%s>" - (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 </%s>: 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 <!-- just like comment-end markers. - (if (and (eq (car lcon) 'tag) - (looking-at "--") - (save-excursion (goto-char (cdr lcon)) (looking-at "<!--"))) - (setq lcon (cons 'comment (+ (cdr lcon) 2)))) - - (case (car lcon) - - (string - ;; Go back to previous non-empty line. - (while (and (> (point) (cdr lcon)) - (zerop (forward-line -1)) - (looking-at "[ \t]*$"))) - (if (> (point) (cdr lcon)) - ;; Previous line is inside the string. - (current-indentation) - (goto-char (cdr lcon)) - (1+ (current-column)))) - - (comment - (let ((mark (looking-at "--"))) - ;; Go back to previous non-empty line. - (while (and (> (point) (cdr lcon)) - (zerop (forward-line -1)) - (or (looking-at "[ \t]*$") - (if mark (not (looking-at "[ \t]*--")))))) - (if (> (point) (cdr lcon)) - ;; Previous line is inside the comment. - (skip-chars-forward " \t") - (goto-char (cdr lcon)) - ;; Skip `<!' to get to the `--' with which we want to align. - (search-forward "--") - (goto-char (match-beginning 0))) - (when (and (not mark) (looking-at "--")) - (forward-char 2) (skip-chars-forward " \t")) - (current-column))) - - ;; We don't know how to indent it. Let's be honest about it. - (cdata nil) - ;; We don't know how to indent it. Let's be honest about it. - (pi nil) - - (tag - (goto-char (1+ (cdr lcon))) - (skip-chars-forward "^ \t\n") ;Skip tag name. - (skip-chars-forward " \t") - (if (not (eolp)) - (current-column) - ;; This is the first attribute: indent. - (goto-char (1+ (cdr lcon))) - (+ (current-column) sgml-basic-offset))) - - (text - (while (looking-at "</") - (forward-sexp 1) - (skip-chars-forward " \t")) - (let* ((here (point)) - (unclosed (and ;; (not sgml-xml-mode) - (looking-at sgml-tag-name-re) - (assoc-string (match-string 1) - sgml-unclosed-tags 'ignore-case) - (match-string 1))) - (context - ;; If possible, align on the previous non-empty text line. - ;; Otherwise, do a more serious parsing to find the - ;; tag(s) relative to which we should be indenting. - (if (and (not unclosed) (skip-chars-backward " \t") - (< (skip-chars-backward " \t\n") 0) - (back-to-indentation) - (> (point) (cdr lcon))) - nil - (goto-char here) - (nreverse (sgml-get-context (if unclosed nil 'empty))))) - (there (point))) - ;; Ignore previous unclosed start-tag in context. - (while (and context unclosed - (eq t (compare-strings - (sgml-tag-name (car context)) nil nil - unclosed nil nil t))) - (setq context (cdr context))) - ;; Indent to reflect nesting. - (cond - ;; If we were not in a text context after all, let's try again. - ((and context (> (sgml-tag-end (car context)) here)) - (goto-char here) - (sgml-calculate-indent - (cons (if (memq (sgml-tag-type (car context)) '(comment cdata)) - (sgml-tag-type (car context)) 'tag) - (sgml-tag-start (car context))))) - ;; Align on the first element after the nearest open-tag, if any. - ((and context - (goto-char (sgml-tag-end (car context))) - (skip-chars-forward " \t\n") - (< (point) here) (sgml-at-indentation-p)) - (current-column)) - (t - (goto-char (or (and (null context) - mumamo-sgml-get-context-last-close) - there)) - (+ (current-column) - (* sgml-basic-offset (length context))))))) - - (otherwise - (error "Unrecognized context %s" (car lcon))) - - )) - -(defadvice sgml-calculate-indent (around - mumamo-ad-sgml-calculate-indent - activate - compile) - (setq ad-return-value (mumamo-sgml-calculate-indent (ad-get-arg 0)))) - -(defadvice python-eldoc-function (around - mumamo-ad-python-eldoc-function - activate - compile) - (if (not mumamo-multi-major-mode) - ad-do-it - (let ((here (point))) - (unwind-protect - (save-restriction - (mumamo-narrow-to-chunk-inner) - ad-do-it) - (goto-char here))))) - -;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; The END -;;(when buffer-file-name (message "Finished evaluating %s" buffer-file-name)) -;;(when load-file-name (message "Finished loading %s" load-file-name)) - -(provide 'mumamo) -;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -;;; mumamo.el ends bere |