;;; multi-mode.el --- support for multiple major modes
;; Copyright (C) 2003, 2004, 2007, 2009 Free Software Foundation, Inc.
;; Author: Dave Love <fx@gnu.org>
;; Keywords: languages, extensions, files
;; Created: Sept 2003
;; $Revision: 1.11 $
;; URL: http://www.loveshack.ukfsn.org/emacs
;; This file 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 of the License, or
;; (at your option) any later version.
;; This file 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. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; This is a framework for a sort of meta mode which provides support
;; for multiple major modes in different regions (`chunks') of a
;; buffer -- sort of. Actually, multiple indirect buffers are used,
;; one per mode (apart from the base buffer, which has the default
;; mode). A post-command hook selects the correct buffer for the mode
;; around point. This is done on the basis of calling the elements of
;; `multi-chunk-fns' and taking the value corresponding to a start
;; position closest to point.
;; [I originally tried maintaining information about the local major
;; mode on a text property maintained by font-lock along with a
;; `point-entered' property to control changing the indirect buffer.
;; This worked less well for reasons I've forgotten, unfortunately.
;; The post-command hook seems to be efficient enough in the simple
;; cases I've tried, and is most general.]
;; Using indirect buffers ensures that we always have the correct
;; local buffer properties like the keymap and syntax table, including
;; the local variable list. There are other implementations of this
;; sort of thing, e.g. for literate programming, but as far as I know,
;; they all work either by continually re-executing the major mode
;; functions or by swapping things like the keymap in and out
;; explicitly. Using indirect buffers seems to be the right thing and
;; is at least potentially more robust, for instance for things like
;; specific subprocesses associated with the buffer for Ispell or
;; whatever. (However, it has the potential confusion of there
;; actually being multiple buffers, even if they mostly act like one.
;; It also may interact badly with other modes using
;; `post-command-hook', as with Flyspell.) Also, it's fairly simple.
;; Maybe it won't turn out to be the best approach, but it currently
;; seems to me to be better than the approach used by MMM mode
;; <URL:http://mmm-mode.sourceforge.net/>, and is a lot less code. I
;; suspect doing the job any better would require fairly serious
;; surgery on buffer behaviour. For instance, consider being able
;; programmatically to treat discontinuous buffer regions as
;; continuous according to, say, text properties. That would work
;; rather like having multiple gaps which the most primitive movement
;; functions skip.
;; The other major difference to MMM mode is that we don't operate on
;; more-or-less static regions in different modes which need to be
;; re-parsed explicitly and/or explicitly inserted. Instead they're
;; dynamically defined, so that random editing DTRT.
;; Things like font-lock and Imenu need to be done piecewise over the
;; chunks. Some functions, such as indentation, should be executed
;; with the buffer narrowed to the current chunk. This ensures they
;; aren't thrown by syntax in other chunks which could confuse
;; `parse-partial-sexp'.
;; The intention is that other major modes can be defined with this
;; framework for specific purposes, e.g. literate programming systems,
;; e.g. literate Haskell, mixing Haskell and LaTeX chunks. See the
;; example of haskell-latex.el, which can activate the literate mode
;; just by adding to `haskell-mode-hook'. The multiple modes can also
;; be chosen on the basis of the file contents, e.g. noweb.el.
;; Problems:
;; * C-x C-v in the indirect buffer just kills both buffers. (Perhaps an
;; Emacs bug.)
;; * Font-locking doesn't always work properly in Emacs 21, due to lack
;; of `font-lock-dont-widen', e.g. see the commentary in
;; haskell-latex.el.
;; * C-x C-w in Emacs 21 may change the mode when it shouldn't.
;; * Flyspell needs modifying so as not to cause trouble with this.
;; For the moment we hack the Flyspell hook functions.
;; * The behaviour of the region can appear odd if point and mark are in
;; regions corresponding to different modes, since they are actually in
;; different buffers. We really want point and marks to be shared among
;; the indirect buffers.
;; * `view-file' doesn't work properly -- only the main buffer gets the
;; minor mode. Probably fixable using `view-mode-hook'.
;; * Doubtless facilities other than Imenu, Font Lock and Flyspell
;; should be supported explicitly or fixed up to work with this,
;; e.g. by narrowing to the chunk around commands. There may be a
;; need for more hooks or other support in base Emacs to help.
;; * Fontification currently doesn't work properly with modes which
;; define their own fontification functions, at least the way nXML mode
;; does it. nXML seems to need hacking to get this right, maybe by
;; converting it to use font-lock. nXML is the only mode I know
;; which defines its own `fontification-functions', although PSGML
;; does its own fontification differently again. Generally, any
;; fontification which doesn't respect the narrowing in force will
;; cause problems. (One might think about `flet'ting `widen' to
;; `ignore' around fontification functions, but that means they can't
;; parse from a previous point, as things like nXML should
;; legitimately be able to do.)
;; Todo:
;; * Provide a simple way to define multi-chunk functions by a series
;; of delimiting regexps, similarly to MMM mode -- someone asked for
;; that.
;; * Provide a means for code describing `island' chunks, which
;; doesn't know about the base or other modes, to describe a chain
;; of chunks in that mode for mapping over chunks.
;;; Code:
(require 'font-lock)
(require 'imenu)
(eval-when-compile (require 'advice))
(defvar multi-indirect-buffers-alist nil
"Alist of direct and indirect buffers v. major modes.
Internal use. Buffer local.")
(make-variable-buffer-local 'multi-indirect-buffers-alist)
(defvar multi-normal-fontify-function nil
"Fontification function normally used by the buffer's major mode.
Internal use. Buffer local.")
(make-variable-buffer-local 'multi-normal-fontify-function)
(defvar multi-normal-fontify-functions nil
"Fontification functions normally used by the buffer's major mode.
Internal use. Buffer local.")
(make-variable-buffer-local 'multi-normal-fontify-functions)
(defvar multi-indirect-buffer-hook nil
"Hook run by `multi-install-mode' in each indirect buffer.
It is run after all the indirect buffers have been set up.")
(defvar multi-select-mode-hook nil
"Hook run after a different mode is selected.")
(defvar multi-chunk-fns nil
"List of functions to determine the modes of chunks.
Each takes a single arg, the position at which to find the mode. It returns
a list (MODE START END).
Buffer local.")
(make-variable-buffer-local 'multi-chunk-fns)
(defsubst multi-base-buffer ()
"Return base buffer of current buffer, or the current buffer if it's direct."
(or (buffer-base-buffer (current-buffer))
(current-buffer)))
(defvar multi-late-index-function nil
"Original value of `imenu-create-index-function' for the buffer's mode.")
(make-variable-buffer-local 'multi-late-index-function)
;; This isn't called `multi-mode-alist', since that will get treated
;; as risky in file variables.
(defvar multi-alist nil
"Alist of elements (MODE . FUNCTION) specifying a buffer's multiple modes.
MODE is a major mode and FUNCTION is a function used as an element of
`multi-chunk-fns' or nil. Use nil if MODE is detected by another element
of the alist.
This is intended to be set as a file variable in a file which specifies
`multi-mode' as its major mode.")
;; See the commentary below.
(defun multi-hack-local-variables ()
"Like `hack-local-variables', but ignore `mode' items."
(let ((late-hack (symbol-function 'hack-one-local-variable)))
(fset 'hack-one-local-variable
(lambda (var val)
(unless (eq var 'mode)
(funcall late-hack var val))))
(unwind-protect
(hack-local-variables)
(fset 'hack-one-local-variable late-hack))))
(defun multi-install-mode (mode &optional chunk-fn base)
"Add MODE to the multiple major modes supported by the current buffer.
CHUNK-FN, if non-nil, is a function to select the mode of a chunk,
added to the list `multi-chunk-fns'. BASE non-nil means that this
is the base mode."
(unless (memq mode multi-indirect-buffers-alist) ; be idempotent
;; This is part of a grim hack for lossage in AUCTeX, which
;; bogusly advises `hack-one-local-variable'. This loses, due to
;; the way advice works, when we run `multi-hack-local-variables'
;; below -- there ought to be a way round this, probably with CL's
;; flet. Any subsequent use of it then fails because advice has
;; captured the now-unbound variable `late-hack'... Thus ensure
;; we've loaded the mode in advance to get any autoloads sorted
;; out. Do it generally in case other modes have similar
;; problems. [The AUCTeX stuff is in support of an undocumented
;; feature which is unnecessary and, anyway, wouldn't need advice
;; to implement. Unfortunately the maintainer seems not to
;; understand the local variables mechanism and wouldn't remove
;; this. To invoke minor modes, you should just use `mode:' in
;; `local variables'.]
(if (eq 'autoload (car-safe (indirect-function mode)))
(with-temp-buffer
(insert "Local Variables:\nmode: fundamental\nEnd:\n")
(funcall mode)
(hack-local-variables)))
(let ((new-buffer (if base
(current-buffer)
;; Perhaps the name uniquification should use
;; the mode name somehow (without getting long).
(make-indirect-buffer (current-buffer)
(generate-new-buffer-name
(buffer-name))))))
(with-current-buffer (multi-base-buffer)
(push (cons mode new-buffer) multi-indirect-buffers-alist)
(let ((alist multi-indirect-buffers-alist)
(hook multi-indirect-buffer-hook)
(fns (if chunk-fn
(add-to-list 'multi-chunk-fns chunk-fn)
multi-chunk-fns))
(alist2 multi-alist)
(file (buffer-file-name))
(base-name (buffer-name))
(coding buffer-file-coding-system)
(multi-mode t)) ; The modes might examine this.
(with-current-buffer new-buffer
(unless (and base (eq mode major-mode))
(funcall mode))
;; Now we can make it local:
(set (make-local-variable 'multi-mode) t)
;; Use file's local variables section to set variables in
;; this buffer. (Don't just copy local variables from the
;; base buffer because it may have set things locally that
;; we don't want in the other modes.) We need to prevent
;; `mode' being processed and re-setting the major mode.
;; It all goes badly wrong if `hack-one-local-variable' is
;; advised. The appropriate mechanism to get round this
;; appears to be `ad-with-originals', but we don't want to
;; pull in the advice package unnecessarily. `flet'-like
;; mechanisms lose with advice because `fset' acts on the
;; advice anyway.
(if (featurep 'advice)
(ad-with-originals (hack-one-local-variable)
(multi-hack-local-variables))
(multi-hack-local-variables))
;; Indentation should first narrow to the chunk. Modes
;; should normally just bind `indent-line-function' to
;; handle indentation.
(when indent-line-function ; not that it should ever be nil...
(set (make-local-variable 'indent-line-function)
`(lambda ()
(save-restriction
(multi-narrow-to-chunk)
(,indent-line-function)))))
;; Now handle the case where the mode binds TAB directly.
;; Bind it in an overriding map to use the local definition,
;; but narrowed to the chunk.
(let ((tab (local-key-binding "\t")))
(when tab
(make-local-variable 'minor-mode-map-alist)
(push (cons multi-mode
(let ((map (make-sparse-keymap)))
(define-key map "\t"
`(lambda ()
(interactive)
(save-restriction
(multi-narrow-to-chunk)
(call-interactively ',tab))))
map))
minor-mode-map-alist)))
(setq multi-normal-fontify-function
font-lock-fontify-region-function)
(set (make-local-variable 'font-lock-fontify-region-function)
#'multi-fontify-region)
(setq multi-normal-fontify-functions fontification-functions)
(setq fontification-functions '(multi-fontify))
;; Don't let parse-partial-sexp get fooled by syntax outside
;; the chunk being fontified. (Not in Emacs 21.)
(set (make-local-variable 'font-lock-dont-widen) t)
(setq multi-late-index-function imenu-create-index-function)
(setq imenu-create-index-function #'multi-create-index
multi-indirect-buffer-hook hook)
;; Kill the base buffer along with the indirect one; careful not
;; to infloop.
(add-hook 'kill-buffer-hook
'(lambda ()
(setq kill-buffer-hook nil)
(kill-buffer (buffer-base-buffer (current-buffer))))
t t)
;; This should probably be at the front of the hook list, so
;; that other hook functions get run in the (perhaps)
;; newly-selected buffer.
(add-hook 'post-command-hook 'multi-select-buffer nil t)
;; Avoid the uniqified name for the indirect buffer in the
;; mode line.
(setq mode-line-buffer-identification
(propertized-buffer-identification base-name))
;; Fixme: Are there other things to copy?
(setq buffer-file-coding-system coding)
;; For benefit of things like VC
(setq buffer-file-name file)
(vc-find-file-hook))
;; Propagate updated values of the relevant buffer-local
;; variables to the indirect buffers.
(dolist (x alist)
(if (car x)
(with-current-buffer (cdr x)
(setq multi-chunk-fns fns)
(setq multi-indirect-buffers-alist alist)
(setq multi-alist alist2)
(run-hooks 'multi-indirect-buffer-hook)))))))))
(defun multi-map-over-chunks (beg end thunk)
"For all chunks between BEG and END, execute THUNK.
THUNK is a function of no args. It is executed with point at the
beginning of the chunk and with the buffer narrowed to the chunk."
(save-excursion
(save-window-excursion
(goto-char beg)
(while (< (point) end)
(multi-select-buffer)
(save-restriction
(multi-narrow-to-chunk)
(funcall thunk)
(goto-char (point-max)))
(unless (multi-next-chunk-start)
(goto-char (point-max)))))))
;; We need this for asynchronous fontification by jit-lock, even
;; though we're redefining `fontification-functions'.
(defun multi-fontify-region (beg end loudly)
"Multi-mode font-lock fontification function.
Fontifies chunk-by chunk within the region.
Assigned to `font-lock-fontify-region-function'."
(let* ((modified (buffer-modified-p))
(buffer-undo-list t)
(inhibit-read-only t)
(inhibit-point-motion-hooks t)
(inhibit-modification-hooks t)
deactivate-mark)
(font-lock-unfontify-region beg end)
(save-restriction
(widen)
(multi-map-over-chunks
beg end (lambda ()
(if (and font-lock-mode font-lock-keywords)
(funcall multi-normal-fontify-function
(point-min) (point-max) loudly)))))
;; In case font-lock isn't done for some mode:
(put-text-property beg end 'fontified t)
(when (and (not modified) (buffer-modified-p))
(set-buffer-modified-p nil))))
;; I'm not sure it's worth trying to support non-font-lock
;; fontification functions like this (see this file's commentary).
(defun multi-fontify (start)
"Multi-mode fontification function.
Fontifies chunk-by-chunk within the region from START for up to
`multi-fontification-chunk-size' characters."
(save-restriction
(multi-narrow-to-chunk)
(run-hook-with-args 'multi-normal-fontify-functions start)))
(defun multi-create-index ()
"Create Imenu index alist for the currently-selected buffer.
Works piece-wise in all the chunks with the same major mode.
Assigned to `imenu-create-index-function'."
(let ((selected-mode major-mode)
imenu-alist ; accumulator
last mode)
(multi-map-over-chunks
(point-min) (point-max)
(lambda ()
(if (eq major-mode selected-mode)
;; Index this chunk and merge results with accumulator.
(dolist (elt (funcall multi-late-index-function))
(if (not (listp (cdr elt)))
(push elt imenu-alist) ; normal element
(let ((elt2 (assoc (car elt) imenu-alist))) ; submenu
;; Fixme: Assumes only a single level of submenu.
(if elt2
(setcdr elt2 (append (cdr elt) (cdr elt2)))
(push elt imenu-alist))))))))
imenu-alist))
(defun multi-next-chunk-start ()
"Move to the start of the next chunk."
(widen)
(goto-char (nth 2 (multi-find-mode-at)))
(unless (eobp)
(forward-char)
t))
(defun multi-narrow-to-chunk ()
"Narrow to the current chunk."
(interactive)
(unless (= (point-min) (point-max))
(apply #'narrow-to-region (cdr (multi-find-mode-at)))))
(defun multi-select-buffer ()
"Select the appropriate (indirect) buffer corresponding to point's context."
;; It may help to catch errors here. If there are context-dependent
;; errors, it may well work correctly when point changes, but if it
;; gets an error, it will be removed from post-command-hook and there
;; won't be useful debugging context anyway.
(condition-case ()
(let ((buffer (cdr (assoc (car (multi-find-mode-at))
multi-indirect-buffers-alist))))
(unless (eq buffer (current-buffer))
(let* ((point (point))
(window-start (window-start))
(visible (pos-visible-in-window-p))
(oldbuf (current-buffer)))
(when (buffer-live-p buffer)
(switch-to-buffer buffer)
(bury-buffer oldbuf)
(goto-char point)
;; Avoid the display jumping around.
(when visible
(set-window-start (get-buffer-window buffer t) window-start))
(unless (eq buffer oldbuf)
(run-hooks 'multi-select-mode-hook))))))
(error nil)))
(defvar multi-mode-list (list t t t))
(defsubst multi-make-list (mode start end)
"Constructor for lists returned by elements of `multi-chunk-fns' &c.
Destructively modifies `multi-mode-list' to avoid consing in
`post-command-hook'."
(setcar multi-mode-list mode)
(setcar (cdr multi-mode-list) start)
(setcar (cddr multi-mode-list) end)
multi-mode-list)
;; It would be nice to cache the results of this on text properties,
;; but that probably won't work well if chunks can be nested. In that
;; case, you can't just mark everything between delimiters -- you have
;; to consider other possible regions between them. For now, we do
;; the calculation each time, scanning outwards from point.
(defun multi-find-mode-at (&optional pos)
"Apply elements of `multi-chunk-fns' to determine major mode at POS.
Return a list (MODE START END), the value returned by the function in the
list for which START is closest to POS (and before it); i.e. the innermost
mode is selected. POS defaults to point."
(let ((fns multi-chunk-fns)
(start (point-min))
(mode (with-current-buffer (multi-base-buffer)
major-mode))
(end (point-max))
(pos (or pos (point)))
val)
(save-restriction
(widen)
(dolist (fn multi-chunk-fns)
(setq val (funcall fn pos))
(if (and val (or (not mode)
(>= (nth 1 val) start)))
(setq mode (nth 0 val)
start (nth 1 val)
end (nth 2 val)))))
(unless (and (<= start end) (<= pos end) (>= pos start))
(error "Bad multi-mode selection: %s, %s"
(multi-make-list mode start end) pos))
(if (= start end)
(setq end (1+ end)))
(multi-make-list mode start end)))
;; This was basically for testing, and isn't a reasonable thing to use
;; otherwise.
;; (define-derived-mode multi-mode fundamental-mode ""
;; "Pseudo major mode controlling multiple major modes apparently in a buffer.
;; Actually maintains multiple views of the data in indirect buffers and
;; switches between them according to the context of point with a post-command
;; hook. Depends on a specification of `multi-alist' in file variables."
;; ;; We need to do the work after file variables have been processed so
;; ;; that we can use a specification of `multi-alist'.
;; (set (make-local-variable 'hack-local-variables-hook)
;; #'multi-mode-install-modes))
(defun multi-mode-install-modes ()
"Process `multi-alist' and create the appropriate buffers."
(if multi-alist
(let ((elt (pop multi-alist)))
(multi-install-mode (car elt) (cdr elt) t)
(dolist (elt multi-alist)
(multi-install-mode (car elt) (cdr elt))))
(fundamental-mode)
(error "`multi-alist' not defined for multi-mode")))
;; In 21.3, Flyspell breaks things, apparently by getting an error in
;; post-command-hook and thus clobbering it. In development code it
;; doesn't do that, but does check indirect buffers it shouldn't. I'm
;; not sure exactly how this happens, but checking flyspell-mode in
;; the hook functions cures this. For the moment, we'll hack this up.
;; (Let's not bring advice into it...)
(eval-after-load "flyspell"
'(progn
(defalias 'flyspell-post-command-hook
`(lambda ()
,(concat (documentation 'flyspell-post-command-hook)
"\n\n[Wrapped by multi-mode.]")
(if flyspell-mode
(funcall ,(symbol-function 'flyspell-post-command-hook)))))
(defalias 'flyspell-pre-command-hook
`(lambda ()
(concat (documentation 'flyspell-pre-command-hook)
"\n\n[Wrapped by multi-mode.]")
(if 'flyspell-mode
(funcall ,(symbol-function 'flyspell-pre-command-hook)))))))
(provide 'multi-mode)
;;; multi-mode.el ends here
