summaryrefslogtreecommitdiffstats
path: root/emacs.d/lisp/multi-mode/multi-mode.el
blob: 2105fda5a6576695da6127cfd61fd15c9a5b36a8 (plain) (blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
;;; 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