Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 446 lines (395 sloc) 16.329 kb
bb60f11 Initial revision
mas authored
1 ;;; mmm-cmds.el --- MMM Mode interactive commands and keymap
2
3 ;; Copyright (C) 2000 by Michael Abraham Shulman
4
6485ce3 Fixed stupid bug, so autoloading will actually work
viritrilbia authored
5 ;; Author: Michael Abraham Shulman <viritrilbia@users.sourceforge.net>
e3ef1f8 Collapsed undo of insertion into one command.
viritrilbia authored
6 ;; Version: $Id: mmm-cmds.el,v 1.18 2003/03/25 21:48:33 viritrilbia Exp $
bb60f11 Initial revision
mas authored
7
8 ;;{{{ GPL
9
10 ;; This file is free software; you can redistribute it and/or modify
11 ;; it under the terms of the GNU General Public License as published by
12 ;; the Free Software Foundation; either version 2, or (at your option)
13 ;; any later version.
14
15 ;; This file is distributed in the hope that it will be useful,
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 ;; GNU General Public License for more details.
19
20 ;; You should have received a copy of the GNU General Public License
21 ;; along with GNU Emacs; see the file COPYING. If not, write to
22 ;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
23 ;; Boston, MA 02111-1307, USA.
24
25 ;;}}}
26
27 ;;; Commentary:
28
29 ;; This file contains the interactive commands for MMM Mode.
30
31 ;;; Code:
32
33 (require 'font-lock)
34 (require 'mmm-compat)
4ccebfd Moved `require's back to top level for byte-compiling.
mas authored
35 (require 'mmm-vars)
36 (require 'mmm-class)
bb60f11 Initial revision
mas authored
37
8ed11ab Added delimiter regions and region name matching.
viritrilbia authored
38 ;; APPLYING CLASSES
bb60f11 Initial revision
mas authored
39 ;;{{{ Applying Predefined Classes
40
41 (defun mmm-ify-by-class (class)
42 "Add submode regions according to an existing submode class."
28e978c (mmm-ify-by-class): Added completion on all defined classes.
mas authored
43 (interactive
44 (list (intern
d504cd7 (mmm-ify-by-class): Added completion on autoloaded classes. Excluded
mas authored
45 (completing-read
46 "Submode Class: "
47 (remove-duplicates
ce6b28a (mmm-ify-by-class): Removed duplicates from completion list.
viritrilbia authored
48 (mapcar #'(lambda (spec) (list (symbol-name (car spec))))
6485ce3 Fixed stupid bug, so autoloading will actually work
viritrilbia authored
49 (append
ce6b28a (mmm-ify-by-class): Removed duplicates from completion list.
viritrilbia authored
50 (remove-if #'(lambda (spec) (plist-get (cdr spec) :private))
51 mmm-classes-alist)
52 (remove-if #'caddr mmm-autoloaded-classes)))
53 :test #'equal)
d504cd7 (mmm-ify-by-class): Added completion on autoloaded classes. Excluded
mas authored
54 nil t))))
28e978c (mmm-ify-by-class): Added completion on all defined classes.
mas authored
55 (unless (eq class (intern ""))
56 (mmm-apply-class class)
57 (mmm-add-to-history class)
58 (mmm-update-font-lock-buffer)))
bb60f11 Initial revision
mas authored
59
60 ;;}}}
61 ;;{{{ Applying by the Region
62
63 (defun mmm-ify-region (submode front back)
64 "Add a submode region for SUBMODE coinciding with current region."
65 (interactive "aSubmode: \nr")
66 (mmm-ify :submode submode :front front :back back)
67 (setq front (mmm-make-marker front t nil)
68 back (mmm-make-marker back nil nil))
69 (mmm-add-to-history `(:submode ,submode :front ,front :back ,back))
5837c90 Fixed font-lock woes (hopefully).
mas authored
70 (mmm-enable-font-lock submode))
bb60f11 Initial revision
mas authored
71
72 ;;}}}
5837c90 Fixed font-lock woes (hopefully).
mas authored
73 ;;{{{ Applying Simple Regexps
bb60f11 Initial revision
mas authored
74
75 (defun mmm-ify-by-regexp
76 (submode front front-offset back back-offset save-matches)
77 "Add SUBMODE regions to the buffer delimited by FRONT and BACK.
78 With prefix argument, prompts for all additional keywords arguments.
79 See `mmm-classes-alist'."
80 (interactive "aSubmode:
81 sFront Regexp:
82 nOffset from Front Regexp:
83 sBack Regexp:
84 nOffset from Back Regexp:
85 nNumber of matched substrings to save: ")
106a130 # Reformatted
mas authored
86 (let ((args (mmm-save-keywords submode front back front-offset
87 back-offset save-matches)))
bb60f11 Initial revision
mas authored
88 (apply #'mmm-ify args)
89 (mmm-add-to-history args))
5837c90 Fixed font-lock woes (hopefully).
mas authored
90 (mmm-enable-font-lock submode))
bb60f11 Initial revision
mas authored
91
92 ;;}}}
8ed11ab Added delimiter regions and region name matching.
viritrilbia authored
93
94 ;; EDITING WITH REGIONS
bb60f11 Initial revision
mas authored
95 ;;{{{ Re-parsing Areas
96
97 (defun mmm-parse-buffer ()
98 "Re-apply all applicable submode classes to current buffer.
99 Clears all current submode regions, reapplies all past interactive
100 mmm-ification, and applies `mmm-classes' and mode-extension classes."
101 (interactive)
102 (message "MMM-ifying buffer...")
103 (mmm-apply-all)
104 (message "MMM-ifying buffer...done"))
105
106 (defun mmm-parse-region (start stop)
107 "Re-apply all applicable submode classes between START and STOP.
108 Clears all current submode regions, reapplies all past interactive
109 mmm-ification, and applies `mmm-classes' and mode-extension classes."
110 (interactive "r")
111 (message "MMM-ifying region...")
112 (mmm-apply-all :start start :stop stop)
113 (message "MMM-ifying region...done"))
114
115 (defun mmm-parse-block (&optional lines)
116 "Re-parse LINES lines before and after point \(default 1).
117 Clears all current submode regions, reapplies all past interactive
118 mmm-ification, and applies `mmm-classes' and mode-extension classes.
119
120 This command is intended for use when you have just typed what should
121 be the delimiters of a submode region and you want to create the
122 region. However, you may want to look into the various types of
123 delimiter auto-insertion that MMM Mode provides. See, for example,
124 `mmm-insert-region'."
125 (interactive "p")
126 (message "MMM-ifying block...")
127 (destructuring-bind (start stop) (mmm-get-block lines)
128 (when (< start stop)
129 (mmm-apply-all :start start :stop stop)))
130 (message "MMM-ifying block...done"))
131
132 (defun mmm-get-block (lines)
133 (let ((inhibit-point-motion-hooks t))
134 (list (save-excursion
135 (forward-line (- lines))
136 (beginning-of-line)
137 (point))
138 (save-excursion
139 (forward-line lines)
140 (end-of-line)
141 (point)))))
142
143 ;;}}}
8ed11ab Added delimiter regions and region name matching.
viritrilbia authored
144 ;;{{{ Reparse Current Region
145
146 (defun mmm-reparse-current-region ()
147 "Clear and reparse the area of the current submode region.
148 Use this command if a submode region's boundaries have become wrong."
149 (interactive)
150 (let ((ovl (mmm-overlay-at (point) 'all)))
151 (when ovl
152 (let ((beg (save-excursion
153 (goto-char (mmm-front-start ovl))
154 (forward-line -1)
155 (point)))
156 (end (save-excursion
157 (goto-char (mmm-back-end ovl))
158 (forward-line 1)
159 (point))))
160 (mmm-parse-region beg end)))))
161
162 ;;}}}
bb60f11 Initial revision
mas authored
163 ;;{{{ Clear Submode Regions
164
165 ;; See also `mmm-clear-history' which is interactive.
166
167 (defun mmm-clear-current-region ()
168 "Deletes the submode region point is currently in, if any."
169 (interactive)
170 (delete-overlay (mmm-overlay-at (point) 'all)))
171
172 (defun mmm-clear-regions (start stop)
173 "Deletes all submode regions from START to STOP."
174 (interactive "r")
175 (mmm-clear-overlays start stop))
176
177 (defun mmm-clear-all-regions ()
178 "Deletes all submode regions in the current buffer."
179 (interactive)
180 (mmm-clear-overlays))
181
182 ;;}}}
183 ;;{{{ End Current Region
184
185 (defun* mmm-end-current-region (&optional arg)
186 "End current submode region.
187 If ARG is nil, end it at the most appropriate place, usually its
188 current back boundary. If ARG is non-nil, end it at point. If the
189 current region is correctly bounded, the first does nothing, but the
190 second deletes that delimiter as well.
191
192 If the region's BACK property is a string, it is inserted as above and
193 the overlay moved if necessary. If it is a function, it is called with
194 two arguments--the overlay, and \(if ARG 'middle t)--and must do the
195 entire job of this function."
196 (interactive "P")
197 (let ((ovl (mmm-overlay-at)))
198 (when ovl
199 (combine-after-change-calls
200 (save-match-data
201 (save-excursion
202 (when (mmm-match-back ovl)
203 (if arg
204 (replace-match "")
205 (return-from mmm-end-current-region)))))
206 (let ((back (overlay-get ovl 'back)))
207 (cond ((stringp back)
208 (save-excursion
209 (unless arg (goto-char (overlay-end ovl)))
210 (save-excursion (insert back))
211 (move-overlay ovl (overlay-start ovl) (point))))
212 ((functionp back)
213 (funcall back ovl (if arg 'middle t))))))
214 (mmm-refontify-maybe (save-excursion (forward-line -1) (point))
215 (save-excursion (forward-line 1) (point))))))
216
217 ;;}}}
8ed11ab Added delimiter regions and region name matching.
viritrilbia authored
218 ;;{{{ Narrow to Region
219
220 (defun mmm-narrow-to-submode-region (&optional pos)
221 "Narrow to the submode region at point."
222 (interactive)
223 ;; Probably don't use mmm-current-overlay here, because this is
224 ;; sometimes called from inside messy functions.
225 (let ((ovl (mmm-overlay-at pos)))
226 (when ovl
227 (narrow-to-region (overlay-start ovl) (overlay-end ovl)))))
228
229 ;; The inverse command is `widen', usually on `C-x n w'
230
231 ;;}}}
232
233 ;; INSERTING REGIONS
bb60f11 Initial revision
mas authored
234 ;;{{{ Insert regions by keystroke
235
236 ;; This is the "default" binding in the MMM Mode keymap. Keys defined
237 ;; by classes should be control keys, to avoid conflicts with MMM
238 ;; commands.
239 (defun mmm-insert-region (arg)
240 "Insert a submode region based on last character in invoking keys.
241 Keystrokes after `mmm-mode-prefix-key' which are not bound to an MMM
242 Mode command \(see `mmm-command-modifiers') are passed on to this
243 function. If they have the modifiers `mmm-insert-modifiers', then they
244 are looked up, sans those modifiers, in all current submode classes to
245 find an insert skeleton. For example, in Mason, `p' \(with appropriate
246 prefix and modifiers) will insert a <%perl>...</%perl> region."
247 (interactive "P")
248 (let* ((seq (this-command-keys))
249 (event (aref seq (1- (length seq))))
250 (mods (event-modifiers event))
251 (key (mmm-event-key event)))
252 (if (subsetp mmm-insert-modifiers mods)
253 (mmm-insert-by-key
254 (append (set-difference mods mmm-insert-modifiers)
255 key)
256 arg))))
257
258 (defun mmm-insert-by-key (key &optional arg)
259 "Insert a submode region based on event KEY.
260 Inspects all the classes of the current buffer to find a matching
261 :insert key sequence. See `mmm-classes-alist'. ARG, if present, is
262 passed on to `skeleton-proxy-new' to control wrapping.
263
264 KEY must be a list \(MODIFIERS... . BASIC-KEY) where MODIFIERS are
265 symbols such as shift, control, etc. and BASIC-KEY is a character code
266 or a symbol such as tab, return, etc. Note that if there are no
267 MODIFIERS, the dotted list becomes simply BASIC-KEY."
268 (multiple-value-bind (class skel str) (mmm-get-insertion-spec key)
269 (when skel
e3ef1f8 Collapsed undo of insertion into one command.
viritrilbia authored
270 (let ((after-change-functions nil)
271 (old-undo buffer-undo-list) undo)
bb60f11 Initial revision
mas authored
272 ;; XEmacs' skeleton doesn't manage positions by itself, so we
273 ;; have to do it.
274 (if mmm-xemacs (setq skeleton-positions nil))
275 (skeleton-proxy-new skel str arg)
276 (destructuring-bind (back end beg front) skeleton-positions
277 ;; TODO: Find a way to trap invalid-parent signals from
278 ;; make-region and undo the skeleton insertion.
8ed11ab Added delimiter regions and region name matching.
viritrilbia authored
279 (let ((match-submode (plist-get class :match-submode))
280 (match-face (plist-get class :match-face))
281 (match-name (plist-get class :match-name))
282 (front-form (regexp-quote (buffer-substring front beg)))
283 (back-form (regexp-quote (buffer-substring end back)))
284 submode face name)
285 (setq submode
286 (mmm-modename->function
287 (if match-submode
288 (mmm-save-all (funcall match-submode front-form))
289 (plist-get class :submode))))
290 (setq face
b25ce5b (mmm-insert-by-key): Use match-face and major-mode-preferences.
mas authored
291 (cond ((functionp match-face)
292 (mmm-save-all
8ed11ab Added delimiter regions and region name matching.
viritrilbia authored
293 (funcall match-face front-form)))
b25ce5b (mmm-insert-by-key): Use match-face and major-mode-preferences.
mas authored
294 (match-face
8ed11ab Added delimiter regions and region name matching.
viritrilbia authored
295 (cdr (assoc front-form match-face)))
b25ce5b (mmm-insert-by-key): Use match-face and major-mode-preferences.
mas authored
296 (t
8ed11ab Added delimiter regions and region name matching.
viritrilbia authored
297 (plist-get class :face))))
298 (setq name
299 (cond ((plist-get class :skel-name)
300 ;; Optimize the name to the user-supplied str
301 ;; if we are so instructed.
302 str)
303 ;; Call it if it is a function
304 ((functionp match-name)
305 (mmm-save-all (funcall match-name front-form)))
306 ;; Now we know it's a string, does it need to
307 ;; be formatted?
308 ((plist-get class :save-name)
309 ;; Yes. Haven't done a match before, so
310 ;; match the front regexp against the given
311 ;; form to format the string
312 (string-match (plist-get class :front)
313 front-form)
314 (mmm-format-matches match-name front-form))
315 (t
316 ;; No, just use it as-is
317 match-name)))
5837c90 Fixed font-lock woes (hopefully).
mas authored
318 (mmm-make-region
8ed11ab Added delimiter regions and region name matching.
viritrilbia authored
319 submode beg end
320 :face face
321 :name name
322 :front front :back back
323 :match-front front-form :match-back back-form
324 :evaporation 'front
c608d3a (mmm-insert-by-key): Made inserted regions beg- and end-sticky.
mas authored
325 ;;; :beg-sticky (plist-get class :beg-sticky)
326 ;;; :end-sticky (plist-get class :end-sticky)
327 :beg-sticky t :end-sticky t
5837c90 Fixed font-lock woes (hopefully).
mas authored
328 :creation-hook (plist-get class :creation-hook))
e3ef1f8 Collapsed undo of insertion into one command.
viritrilbia authored
329 (mmm-enable-font-lock submode)))
330 ;; Now get rid of intermediate undo boundaries, so that the entire
331 ;; insertion can be undone as one action. This should really be
332 ;; skeleton's job, but it doesn't do it.
333 (setq undo buffer-undo-list)
334 (while (not (eq (cdr undo) old-undo))
335 (when (eq (cadr undo) nil)
336 (setcdr undo (cddr undo)))
337 (setq undo (cdr undo)))))))
bb60f11 Initial revision
mas authored
338
339 (defun mmm-get-insertion-spec (key &optional classlist)
340 "Get the insertion info for KEY from all classes in CLASSLIST.
341 Return \(CLASS SKEL STR) where CLASS is the class spec a match was
342 found in, SKEL is the skeleton to insert, and STR is the argument.
5837c90 Fixed font-lock woes (hopefully).
mas authored
343 CLASSLIST defaults to the return value of `mmm-get-all-classes',
344 including global classes."
345 (loop for classname in (or classlist (mmm-get-all-classes t))
bb60f11 Initial revision
mas authored
346 for class = (mmm-get-class-spec classname)
347 for inserts = (plist-get class :insert)
348 for skel = (cddr (assoc key inserts))
349 with str
350 ;; If SKEL is a dotted pair, it means call another key's
351 ;; insertion spec with an argument.
352 unless (consp (cdr skel))
353 do (setq str (cdr skel)
cfb0dbc Fixed "sub"-insertion specs like <%perl> under <%TAG> not to insert
mas authored
354 skel (cddr (assoc (car skel) inserts)))
bb60f11 Initial revision
mas authored
355 if skel return (list class skel str)
356 ;; If we have a group class, recurse.
357 if (plist-get class :classes)
358 if (mmm-get-insertion-spec key it)
359 return it
360 else
361 return nil))
362
363 ;;}}}
364 ;;{{{ Help on Insertion
365
366 (defun mmm-insertion-help ()
367 "Display help on currently available MMM insertion commands."
368 (interactive)
369 (with-output-to-temp-buffer "*Help*"
370 (princ "Available MMM Mode Insertion Commands:\n")
371 (princ "Key Inserts\n")
372 (princ "--- -------\n\n")
373 (mapcar #'mmm-display-insertion-key
374 (mmm-get-all-insertion-keys))))
375
376 (defun mmm-display-insertion-key (spec)
377 "Print an insertion binding to standard output.
378 SPEC should be \(KEY NAME ...) where KEY is an insertion key and NAME
379 is a symbol naming the insertion."
380 (let* ((str (make-string 16 ?\ ))
381 ;; This gets us a dotted list, because of the way insertion
382 ;; keys are specified.
383 (key (append mmm-insert-modifiers (car spec)))
e18bbf0 (mmm-display-insertion-key): Prevented (nthcdr -1 ...); breaks in XEm…
mas authored
384 (lastkey (nthcdr (max (1- (safe-length key)) 0) key)))
bb60f11 Initial revision
mas authored
385 ;; Now we make it a true list
386 (if (consp key)
387 (setcdr lastkey (list (cdr lastkey)))
388 (setq key (list key)))
389 ;; Get the spacing right
390 (store-substring str 0
391 (key-description
392 (apply #'vector (append mmm-mode-prefix-key (list key)))))
393 (princ str)
394 ;; Now print the binding symbol
395 (princ (cadr spec))
396 (princ "\n")))
397
398 (defun mmm-get-all-insertion-keys (&optional classlist)
399 "Return an alist of all currently available insertion keys.
400 Elements look like \(KEY NAME ...) where KEY is an insertion key and
401 NAME is a symbol naming the insertion."
402 (remove-duplicates
5837c90 Fixed font-lock woes (hopefully).
mas authored
403 (loop for classname in (or classlist (mmm-get-all-classes t))
bb60f11 Initial revision
mas authored
404 for class = (mmm-get-class-spec classname)
405 append (plist-get class :insert) into keys
406 ;; If we have a group class, recurse.
407 if (plist-get class :classes)
408 do (setq keys (append keys (mmm-get-all-insertion-keys it)))
409 finally return keys)
410 :test #'equal
411 :key #'(lambda (x) (cons (car x) (cadr x)))
412 :from-end t))
413
414 ;;}}}
415
416 ;;{{{ Auto Insertion (copied from interactive session);-COM-
417 ;-COM-
418 ;-COM-;; Don't use `mmm-ify-region' of course. And rather than having
419 ;-COM-;; classes define their own functions, we should have them pass a
420 ;-COM-;; skeleton as an attribute. Then our insert function can turn off
421 ;-COM-;; after-change hooks and add the submode region afterward.
422 ;-COM-
423 ;-COM-(define-skeleton mmm-see-inline
424 ;-COM- "" nil
425 ;-COM- -1 @ " " _ " " @ "%>"
426 ;-COM- '(apply #'mmm-ify-region 'cperl-mode (reverse skeleton-positions)))
427 ;-COM-
428 ;-COM-(define-skeleton mmm-see-other
429 ;-COM- "" nil
430 ;-COM- @ ";\n" _ "\n" @ "<%/" str ">"
431 ;-COM- '(apply #'mmm-ify-region 'cperl-mode (reverse skeleton-positions)))
432 ;-COM-
433 ;-COM-(make-local-hook 'after-change-functions)
434 ;-COM-(add-hook 'after-change-functions 'mmm-detect t)
435 ;-COM-
436 ;-COM-(defun mmm-detect (beg end length)
437 ;-COM- (when (mmm-looking-back-at "<% ")
438 ;-COM- (mmm-see-inline))
439 ;-COM- (when (mmm-looking-back-at "<%\\(\\w+\\)>")
440 ;-COM- (mmm-see-other (match-string 1))))
441 ;-COM-
442 ;;}}}
443
444 (provide 'mmm-cmds)
445
446 ;;; mmm-cmds.el ends here
Something went wrong with that request. Please try again.