| 1 | ;;; skeleton.el --- Lisp language extension for writing statement skeletons -*- coding: utf-8 -*- |
| 2 | |
| 3 | ;; Copyright (C) 1993-1996, 2001-2014 Free Software Foundation, Inc. |
| 4 | |
| 5 | ;; Author: Daniel Pfeiffer <occitan@esperanto.org> |
| 6 | ;; Maintainer: emacs-devel@gnu.org |
| 7 | ;; Keywords: extensions, abbrev, languages, tools |
| 8 | |
| 9 | ;; This file is part of GNU Emacs. |
| 10 | |
| 11 | ;; GNU Emacs is free software: you can redistribute it and/or modify |
| 12 | ;; it under the terms of the GNU General Public License as published by |
| 13 | ;; the Free Software Foundation, either version 3 of the License, or |
| 14 | ;; (at your option) any later version. |
| 15 | |
| 16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 19 | ;; GNU General Public License for more details. |
| 20 | |
| 21 | ;; You should have received a copy of the GNU General Public License |
| 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; A very concise language extension for writing structured statement |
| 27 | ;; skeleton insertion commands for programming language modes. This |
| 28 | ;; originated in shell-script mode and was applied to ada-mode's |
| 29 | ;; commands which shrunk to one third. And these commands are now |
| 30 | ;; user configurable. |
| 31 | |
| 32 | ;;; Code: |
| 33 | |
| 34 | (eval-when-compile (require 'cl-lib)) |
| 35 | |
| 36 | ;; page 1: statement skeleton language definition & interpreter |
| 37 | ;; page 2: paired insertion |
| 38 | ;; page 3: mirror-mode, an example for setting up paired insertion |
| 39 | |
| 40 | |
| 41 | (defvar skeleton-transformation-function 'identity |
| 42 | "If non-nil, function applied to literal strings before they are inserted. |
| 43 | It should take strings and characters and return them transformed, or nil |
| 44 | which means no transformation. |
| 45 | Typical examples might be `upcase' or `capitalize'.") |
| 46 | (defvaralias 'skeleton-transformation 'skeleton-transformation-function) |
| 47 | |
| 48 | ; this should be a fourth argument to defvar |
| 49 | (put 'skeleton-transformation-function 'variable-interactive |
| 50 | "aTransformation function: ") |
| 51 | |
| 52 | |
| 53 | (defvar skeleton-autowrap t |
| 54 | "Controls wrapping behavior of functions created with `define-skeleton'. |
| 55 | When the region is visible (due to `transient-mark-mode' or marking a region |
| 56 | with the mouse) and this is non-nil and the function was called without an |
| 57 | explicit ARG, then the ARG defaults to -1, i.e. wrapping around the visible |
| 58 | region. |
| 59 | |
| 60 | We will probably delete this variable in a future Emacs version |
| 61 | unless we get a substantial number of complaints about the auto-wrap |
| 62 | feature.") |
| 63 | |
| 64 | (defvar skeleton-end-newline t |
| 65 | "If non-nil, make sure that the skeleton inserted ends with a newline. |
| 66 | This just influences the way the default `skeleton-end-hook' behaves.") |
| 67 | |
| 68 | (defvar skeleton-end-hook |
| 69 | (lambda () |
| 70 | (or (eolp) (not skeleton-end-newline) (newline-and-indent))) |
| 71 | "Hook called at end of skeleton but before going to point of interest. |
| 72 | By default this moves out anything following to next line, |
| 73 | unless `skeleton-end-newline' is set to nil. |
| 74 | The variables `v1' and `v2' are still set when calling this.") |
| 75 | |
| 76 | |
| 77 | ;;;###autoload |
| 78 | (defvar skeleton-filter-function 'identity |
| 79 | "Function for transforming a skeleton proxy's aliases' variable value.") |
| 80 | (defvaralias 'skeleton-filter 'skeleton-filter-function) |
| 81 | |
| 82 | (defvar skeleton-untabify nil ; bug#12223 |
| 83 | "When non-nil untabifies when deleting backwards with element -ARG.") |
| 84 | |
| 85 | (defvar skeleton-newline-indent-rigidly nil |
| 86 | "When non-nil, indent rigidly under current line for element `\\n'. |
| 87 | Else use mode's `indent-line-function'.") |
| 88 | |
| 89 | (defvar-local skeleton-further-elements () |
| 90 | "A buffer-local varlist (see `let') of mode specific skeleton elements. |
| 91 | These variables are bound while interpreting a skeleton. Their value may |
| 92 | in turn be any valid skeleton element if they are themselves to be used as |
| 93 | skeleton elements.") |
| 94 | |
| 95 | (defvar skeleton-subprompt |
| 96 | (substitute-command-keys |
| 97 | "RET, \\<minibuffer-local-map>\\[abort-recursive-edit] or \\[help-command]") |
| 98 | "Replacement for %s in prompts of recursive subskeletons.") |
| 99 | |
| 100 | |
| 101 | (defvar skeleton-debug nil |
| 102 | "If non-nil `define-skeleton' will override previous definition.") |
| 103 | |
| 104 | (defvar skeleton-positions nil |
| 105 | "List of positions marked with @, after skeleton insertion. |
| 106 | The list describes the most recent skeleton insertion, and its elements |
| 107 | are integer buffer positions in the reverse order of the insertion order.") |
| 108 | |
| 109 | ;; reduce the number of compiler warnings |
| 110 | (defvar skeleton-il) |
| 111 | (defvar skeleton-modified) |
| 112 | (defvar skeleton-point) |
| 113 | (defvar skeleton-regions) |
| 114 | |
| 115 | (def-edebug-spec skeleton-edebug-spec |
| 116 | ([&or null stringp (stringp &rest stringp) [[¬ atom] def-form]] |
| 117 | &rest &or "n" "_" "-" ">" "@" "&" "!" "resume:" |
| 118 | ("quote" def-form) skeleton-edebug-spec def-form)) |
| 119 | ;;;###autoload |
| 120 | (defmacro define-skeleton (command documentation &rest skeleton) |
| 121 | "Define a user-configurable COMMAND that enters a statement skeleton. |
| 122 | DOCUMENTATION is that of the command. |
| 123 | SKELETON is as defined under `skeleton-insert'." |
| 124 | (declare (doc-string 2) (debug (&define name stringp skeleton-edebug-spec))) |
| 125 | (if skeleton-debug |
| 126 | (set command skeleton)) |
| 127 | `(progn |
| 128 | ;; Tell self-insert-command that this function, if called by an |
| 129 | ;; abbrev, should cause the self-insert to be skipped. |
| 130 | (put ',command 'no-self-insert t) |
| 131 | (defun ,command (&optional str arg) |
| 132 | ,(concat documentation |
| 133 | (if (string-match "\n\\'" documentation) |
| 134 | "" "\n") |
| 135 | "\n" |
| 136 | "This is a skeleton command (see `skeleton-insert'). |
| 137 | Normally the skeleton text is inserted at point, with nothing \"inside\". |
| 138 | If there is a highlighted region, the skeleton text is wrapped |
| 139 | around the region text. |
| 140 | |
| 141 | A prefix argument ARG says to wrap the skeleton around the next ARG words. |
| 142 | A prefix argument of -1 says to wrap around region, even if not highlighted. |
| 143 | A prefix argument of zero says to wrap around zero words---that is, nothing. |
| 144 | This is a way of overriding the use of a highlighted region.") |
| 145 | (interactive "*P\nP") |
| 146 | (skeleton-proxy-new ',skeleton str arg)))) |
| 147 | |
| 148 | ;;;###autoload |
| 149 | (defun skeleton-proxy-new (skeleton &optional str arg) |
| 150 | "Insert SKELETON. |
| 151 | Prefix ARG allows wrapping around words or regions (see `skeleton-insert'). |
| 152 | If no ARG was given, but the region is visible, ARG defaults to -1 depending |
| 153 | on `skeleton-autowrap'. An ARG of M-0 will prevent this just for once. |
| 154 | This command can also be an abbrev expansion (3rd and 4th columns in |
| 155 | \\[edit-abbrevs] buffer: \"\" command-name). |
| 156 | |
| 157 | Optional second argument STR may also be a string which will be the value |
| 158 | of `str' whereas the skeleton's interactor is then ignored." |
| 159 | (skeleton-insert (funcall skeleton-filter-function skeleton) |
| 160 | ;; Pretend C-x a e passed its prefix arg to us |
| 161 | (if (or arg current-prefix-arg) |
| 162 | (prefix-numeric-value (or arg |
| 163 | current-prefix-arg)) |
| 164 | (and skeleton-autowrap |
| 165 | (or (eq last-command 'mouse-drag-region) |
| 166 | (and transient-mark-mode mark-active)) |
| 167 | ;; Deactivate the mark, in case one of the |
| 168 | ;; elements of the skeleton is sensitive |
| 169 | ;; to such situations (e.g. it is itself a |
| 170 | ;; skeleton). |
| 171 | (progn (deactivate-mark) |
| 172 | -1))) |
| 173 | (if (stringp str) |
| 174 | str)) |
| 175 | ;; Return non-nil to tell expand-abbrev that expansion has happened. |
| 176 | ;; Otherwise the no-self-insert is ignored. |
| 177 | t) |
| 178 | |
| 179 | ;;;###autoload |
| 180 | (defun skeleton-insert (skeleton &optional regions str) |
| 181 | "Insert the complex statement skeleton SKELETON describes very concisely. |
| 182 | |
| 183 | With optional second argument REGIONS, wrap first interesting point |
| 184 | \(`_') in skeleton around next REGIONS words, if REGIONS is positive. |
| 185 | If REGIONS is negative, wrap REGIONS preceding interregions into first |
| 186 | REGIONS interesting positions (successive `_'s) in skeleton. |
| 187 | |
| 188 | An interregion is the stretch of text between two contiguous marked |
| 189 | points. If you marked A B C [] (where [] is the cursor) in |
| 190 | alphabetical order, the 3 interregions are simply the last 3 regions. |
| 191 | But if you marked B A [] C, the interregions are B-A, A-[], []-C. |
| 192 | |
| 193 | The optional third argument STR, if specified, is the value for the |
| 194 | variable `str' within the skeleton. When this is non-nil, the |
| 195 | interactor gets ignored, and this should be a valid skeleton element. |
| 196 | |
| 197 | SKELETON is made up as (INTERACTOR ELEMENT ...). INTERACTOR may be nil if |
| 198 | not needed, a prompt-string or an expression for complex read functions. |
| 199 | |
| 200 | If ELEMENT is a string or a character it gets inserted (see also |
| 201 | `skeleton-transformation-function'). Other possibilities are: |
| 202 | |
| 203 | \\n go to next line and indent according to mode, unless |
| 204 | this is the first/last element of a skeleton and point |
| 205 | is at bol/eol |
| 206 | _ interesting point, interregion here |
| 207 | - interesting point, no interregion interaction, overrides |
| 208 | interesting point set by _ |
| 209 | > indent line (or interregion if > _) according to major mode |
| 210 | @ add position to `skeleton-positions' |
| 211 | & do next ELEMENT if previous moved point |
| 212 | | do next ELEMENT if previous didn't move point |
| 213 | -NUM delete NUM preceding characters (see `skeleton-untabify') |
| 214 | resume: skipped, continue here if quit is signaled |
| 215 | nil skipped |
| 216 | |
| 217 | After termination, point will be positioned at the last occurrence of - |
| 218 | or at the first occurrence of _ or at the end of the inserted text. |
| 219 | |
| 220 | Note that \\n as the last element of the skeleton only inserts a |
| 221 | newline if not at eol. If you want to unconditionally insert a newline |
| 222 | at the end of the skeleton, use \"\\n\" instead. Likewise with \\n |
| 223 | as the first element when at bol. |
| 224 | |
| 225 | Further elements can be defined via `skeleton-further-elements'. |
| 226 | ELEMENT may itself be a SKELETON with an INTERACTOR. The user is prompted |
| 227 | repeatedly for different inputs. The SKELETON is processed as often as |
| 228 | the user enters a non-empty string. \\[keyboard-quit] terminates skeleton insertion, but |
| 229 | continues after `resume:' and positions at `_' if any. If INTERACTOR in |
| 230 | such a subskeleton is a prompt-string which contains a \".. %s ..\" it is |
| 231 | formatted with `skeleton-subprompt'. Such an INTERACTOR may also be a list |
| 232 | of strings with the subskeleton being repeated once for each string. |
| 233 | |
| 234 | Quoted Lisp expressions are evaluated for their side-effects. |
| 235 | Other Lisp expressions are evaluated and the value treated as above. |
| 236 | Note that expressions may not return t since this implies an |
| 237 | endless loop. Modes can define other symbols by locally setting them |
| 238 | to any valid skeleton element. The following local variables are |
| 239 | available: |
| 240 | |
| 241 | str first time: read a string according to INTERACTOR |
| 242 | then: insert previously read string once more |
| 243 | help help-form during interaction with the user or nil |
| 244 | input initial input (string or cons with index) while reading str |
| 245 | v1, v2 local variables for memorizing anything you want |
| 246 | |
| 247 | When done with skeleton, but before going back to `_'-point call |
| 248 | `skeleton-end-hook' if that is non-nil." |
| 249 | (let ((skeleton-regions regions)) |
| 250 | (and skeleton-regions |
| 251 | (setq skeleton-regions |
| 252 | (if (> skeleton-regions 0) |
| 253 | (list (copy-marker (point) t) |
| 254 | (save-excursion (forward-word skeleton-regions) |
| 255 | (point-marker))) |
| 256 | (setq skeleton-regions (- skeleton-regions)) |
| 257 | ;; copy skeleton-regions - 1 elements from `mark-ring' |
| 258 | (let ((l1 (cons (mark-marker) mark-ring)) |
| 259 | (l2 (list (copy-marker (point) t)))) |
| 260 | (while (and l1 (> skeleton-regions 0)) |
| 261 | (push (copy-marker (pop l1) t) l2) |
| 262 | (setq skeleton-regions (1- skeleton-regions))) |
| 263 | (sort l2 '<)))) |
| 264 | (goto-char (car skeleton-regions)) |
| 265 | (setq skeleton-regions (cdr skeleton-regions))) |
| 266 | (let ((beg (point)) |
| 267 | skeleton-modified skeleton-point resume: help input v1 v2) |
| 268 | (setq skeleton-positions nil) |
| 269 | (unwind-protect |
| 270 | (cl-progv |
| 271 | (mapcar #'car skeleton-further-elements) |
| 272 | (mapcar (lambda (x) (eval (cadr x))) skeleton-further-elements) |
| 273 | (skeleton-internal-list skeleton str)) |
| 274 | (run-hooks 'skeleton-end-hook) |
| 275 | (sit-for 0) |
| 276 | (or (pos-visible-in-window-p beg) |
| 277 | (progn |
| 278 | (goto-char beg) |
| 279 | (recenter 0))) |
| 280 | (if skeleton-point |
| 281 | (goto-char skeleton-point)))))) |
| 282 | |
| 283 | (defun skeleton-read (prompt &optional initial-input recursive) |
| 284 | "Function for reading a string from the minibuffer within skeletons. |
| 285 | |
| 286 | PROMPT must be a string or a form that evaluates to a string. |
| 287 | It may contain a `%s' which will be replaced by `skeleton-subprompt'. |
| 288 | If non-nil second arg INITIAL-INPUT or variable `input' is a string or |
| 289 | cons with index to insert before reading. If third arg RECURSIVE is non-nil |
| 290 | i.e. we are handling the iterator of a subskeleton, returns empty string if |
| 291 | user didn't modify input. |
| 292 | While reading, the value of `minibuffer-help-form' is variable `help' if that |
| 293 | is non-nil or a default string." |
| 294 | (let ((minibuffer-help-form (or (if (boundp 'help) (symbol-value 'help)) |
| 295 | (if recursive "\ |
| 296 | As long as you provide input you will insert another subskeleton. |
| 297 | |
| 298 | If you enter the empty string, the loop inserting subskeletons is |
| 299 | left, and the current one is removed as far as it has been entered. |
| 300 | |
| 301 | If you quit, the current subskeleton is removed as far as it has been |
| 302 | entered. No more of the skeleton will be inserted, except maybe for a |
| 303 | syntactically necessary termination." |
| 304 | "\ |
| 305 | You are inserting a skeleton. Standard text gets inserted into the buffer |
| 306 | automatically, and you are prompted to fill in the variable parts."))) |
| 307 | (eolp (eolp))) |
| 308 | ;; since Emacs doesn't show main window's cursor, do something noticeable |
| 309 | (or eolp |
| 310 | ;; We used open-line before, but that can do a lot more than we want, |
| 311 | ;; since it runs self-insert-command. E.g. it may remove spaces |
| 312 | ;; before point. |
| 313 | (save-excursion (insert "\n"))) |
| 314 | (unwind-protect |
| 315 | (setq prompt (if (stringp prompt) |
| 316 | (read-string (format prompt skeleton-subprompt) |
| 317 | (setq initial-input |
| 318 | (or initial-input |
| 319 | (symbol-value 'input)))) |
| 320 | (eval prompt))) |
| 321 | (or eolp |
| 322 | (delete-char 1)))) |
| 323 | (if (and recursive |
| 324 | (or (null prompt) |
| 325 | (string= prompt "") |
| 326 | (equal prompt initial-input) |
| 327 | (equal prompt (car-safe initial-input)))) |
| 328 | (signal 'quit t) |
| 329 | prompt)) |
| 330 | |
| 331 | (defun skeleton-internal-list (skeleton-il &optional str recursive) |
| 332 | (let* ((start (line-beginning-position)) |
| 333 | (column (current-column)) |
| 334 | (line (buffer-substring start (line-end-position))) |
| 335 | opoint) |
| 336 | (or str |
| 337 | (setq str `(setq str |
| 338 | (skeleton-read ',(car skeleton-il) nil ,recursive)))) |
| 339 | (when (and (eq (cadr skeleton-il) '\n) (not recursive) |
| 340 | (save-excursion (skip-chars-backward " \t") (bolp))) |
| 341 | (setq skeleton-il (cons nil (cons '> (cddr skeleton-il))))) |
| 342 | (while (setq skeleton-modified (eq opoint (point)) |
| 343 | opoint (point) |
| 344 | skeleton-il (cdr skeleton-il)) |
| 345 | (condition-case quit |
| 346 | (skeleton-internal-1 (car skeleton-il) nil recursive) |
| 347 | (quit |
| 348 | (if (eq (cdr quit) 'recursive) |
| 349 | (setq recursive 'quit |
| 350 | skeleton-il (memq 'resume: skeleton-il)) |
| 351 | ;; Remove the subskeleton as far as it has been shown |
| 352 | ;; the subskeleton shouldn't have deleted outside current line. |
| 353 | (end-of-line) |
| 354 | (delete-region start (point)) |
| 355 | (insert line) |
| 356 | (move-to-column column) |
| 357 | (if (cdr quit) |
| 358 | (setq skeleton-il () |
| 359 | recursive nil) |
| 360 | (signal 'quit 'recursive))))))) |
| 361 | ;; maybe continue loop or go on to next outer resume: section |
| 362 | (if (eq recursive 'quit) |
| 363 | (signal 'quit 'recursive) |
| 364 | recursive)) |
| 365 | |
| 366 | |
| 367 | (defun skeleton-internal-1 (element &optional literal recursive) |
| 368 | (cond |
| 369 | ((or (integerp element) (stringp element)) |
| 370 | (if (and (integerp element) ; -num |
| 371 | (< element 0)) |
| 372 | (if skeleton-untabify |
| 373 | (backward-delete-char-untabify (- element)) |
| 374 | (delete-char element)) |
| 375 | (insert (if (not literal) |
| 376 | (funcall skeleton-transformation-function element) |
| 377 | element)))) |
| 378 | ((or (eq element '\n) ; actually (eq '\n 'n) |
| 379 | ;; The sequence `> \n' is handled specially so as to indent the first |
| 380 | ;; line after inserting the newline (to get the proper indentation). |
| 381 | (and (eq element '>) (eq (nth 1 skeleton-il) '\n) (pop skeleton-il))) |
| 382 | (let ((pos (if (eq element '>) (point)))) |
| 383 | (cond |
| 384 | ((and skeleton-regions (eq (nth 1 skeleton-il) '_)) |
| 385 | (or (eolp) (insert "\n")) |
| 386 | (if pos (save-excursion (goto-char pos) (indent-according-to-mode))) |
| 387 | (indent-region (line-beginning-position) |
| 388 | (car skeleton-regions) nil)) |
| 389 | ;; \n as last element only inserts \n if not at eol. |
| 390 | ((and (null (cdr skeleton-il)) (not recursive) (eolp)) |
| 391 | (if pos (indent-according-to-mode))) |
| 392 | (skeleton-newline-indent-rigidly |
| 393 | (let ((pt (point))) |
| 394 | (insert "\n") |
| 395 | (indent-to (save-excursion |
| 396 | (goto-char pt) |
| 397 | (if pos (indent-according-to-mode)) |
| 398 | (current-indentation))))) |
| 399 | (t (if pos (reindent-then-newline-and-indent) |
| 400 | (insert "\n") |
| 401 | (indent-according-to-mode)))))) |
| 402 | ((eq element '>) |
| 403 | (if (and skeleton-regions (eq (nth 1 skeleton-il) '_)) |
| 404 | (indent-region (line-beginning-position) |
| 405 | (car skeleton-regions) nil) |
| 406 | (indent-according-to-mode))) |
| 407 | ((eq element '_) |
| 408 | (if skeleton-regions |
| 409 | (progn |
| 410 | (goto-char (pop skeleton-regions)) |
| 411 | (and (<= (current-column) (current-indentation)) |
| 412 | (eq (nth 1 skeleton-il) '\n) |
| 413 | (end-of-line 0))) |
| 414 | (or skeleton-point |
| 415 | (setq skeleton-point (point))))) |
| 416 | ((eq element '-) |
| 417 | (setq skeleton-point (point))) |
| 418 | ((eq element '&) |
| 419 | (when skeleton-modified (pop skeleton-il))) |
| 420 | ((eq element '|) |
| 421 | (unless skeleton-modified (pop skeleton-il))) |
| 422 | ((eq element '@) |
| 423 | (push (point) skeleton-positions)) |
| 424 | ((eq 'quote (car-safe element)) |
| 425 | (eval (nth 1 element))) |
| 426 | ((and (consp element) |
| 427 | (or (stringp (car element)) (listp (car element)))) |
| 428 | ;; Don't forget: `symbolp' is also true for nil. |
| 429 | (if (symbolp (car-safe (car element))) |
| 430 | (while (and (skeleton-internal-list element nil t) |
| 431 | ;; If the interactor is nil, don't infinite loop. |
| 432 | (car element))) |
| 433 | (setq literal (car element)) |
| 434 | (while literal |
| 435 | (skeleton-internal-list element (car literal)) |
| 436 | (setq literal (cdr literal))))) |
| 437 | ((null element)) |
| 438 | (t (skeleton-internal-1 (eval element) t recursive)))) |
| 439 | \f |
| 440 | ;; Maybe belongs into simple.el or elsewhere |
| 441 | ;; ;;;###autoload |
| 442 | ;; (define-skeleton local-variables-section |
| 443 | ;; "Insert a local variables section. Use current comment syntax if any." |
| 444 | ;; (completing-read "Mode: " obarray |
| 445 | ;; (lambda (symbol) |
| 446 | ;; (if (commandp symbol) |
| 447 | ;; (string-match "-mode$" (symbol-name symbol)))) |
| 448 | ;; t) |
| 449 | ;; '(save-excursion |
| 450 | ;; (if (re-search-forward page-delimiter nil t) |
| 451 | ;; (error "Not on last page"))) |
| 452 | ;; comment-start "Local Variables:" comment-end \n |
| 453 | ;; comment-start "mode: " str |
| 454 | ;; & -5 | '(kill-line 0) & -1 | comment-end \n |
| 455 | ;; ( (completing-read (format "Variable, %s: " skeleton-subprompt) |
| 456 | ;; obarray |
| 457 | ;; (lambda (symbol) |
| 458 | ;; (or (eq symbol 'eval) |
| 459 | ;; (custom-variable-p symbol))) |
| 460 | ;; t) |
| 461 | ;; comment-start str ": " |
| 462 | ;; (read-from-minibuffer "Expression: " nil read-expression-map nil |
| 463 | ;; 'read-expression-history) | _ |
| 464 | ;; comment-end \n) |
| 465 | ;; resume: |
| 466 | ;; comment-start "End:" comment-end \n) |
| 467 | \f |
| 468 | ;; Variables and command for automatically inserting pairs like () or "". |
| 469 | |
| 470 | (defvar skeleton-pair nil |
| 471 | "If this is nil pairing is turned off, no matter what else is set. |
| 472 | Otherwise modes with `skeleton-pair-insert-maybe' on some keys |
| 473 | will attempt to insert pairs of matching characters.") |
| 474 | |
| 475 | |
| 476 | (defvar skeleton-pair-on-word nil |
| 477 | "If this is nil, paired insertion is inhibited before or inside a word.") |
| 478 | |
| 479 | |
| 480 | (defvar skeleton-pair-filter-function (lambda () nil) |
| 481 | "Attempt paired insertion if this function returns nil, before inserting. |
| 482 | This allows for context-sensitive checking whether pairing is appropriate.") |
| 483 | |
| 484 | |
| 485 | (defvar skeleton-pair-alist () |
| 486 | "An override alist of pairing partners matched against `last-command-event'. |
| 487 | Each alist element, which looks like (ELEMENT ...), is passed to |
| 488 | `skeleton-insert' with no interactor. Variable `str' does nothing. |
| 489 | |
| 490 | Elements might be (?` ?` _ \"''\"), (?\\( ? _ \" )\") or (?{ \\n > _ \\n ?} >).") |
| 491 | |
| 492 | (defvar skeleton-pair-default-alist '((?( _ ?)) (?\)) |
| 493 | (?[ _ ?]) (?\]) |
| 494 | (?{ _ ?}) (?\}) |
| 495 | (?< _ ?>) (?\>) |
| 496 | (?« _ ?») (?\») |
| 497 | (?` _ ?'))) |
| 498 | |
| 499 | ;;;###autoload |
| 500 | (defun skeleton-pair-insert-maybe (arg) |
| 501 | "Insert the character you type ARG times. |
| 502 | |
| 503 | With no ARG, if `skeleton-pair' is non-nil, pairing can occur. If the region |
| 504 | is visible the pair is wrapped around it depending on `skeleton-autowrap'. |
| 505 | Else, if `skeleton-pair-on-word' is non-nil or we are not before or inside a |
| 506 | word, and if `skeleton-pair-filter-function' returns nil, pairing is performed. |
| 507 | Pairing is also prohibited if we are right after a quoting character |
| 508 | such as backslash. |
| 509 | |
| 510 | If a match is found in `skeleton-pair-alist', that is inserted, else |
| 511 | the defaults are used. These are (), [], {}, <> and `' for the |
| 512 | symmetrical ones, and the same character twice for the others." |
| 513 | (interactive "*P") |
| 514 | (if (or arg (not skeleton-pair)) |
| 515 | (self-insert-command (prefix-numeric-value arg)) |
| 516 | (let* ((mark (and skeleton-autowrap |
| 517 | (or (eq last-command 'mouse-drag-region) |
| 518 | (and transient-mark-mode mark-active)))) |
| 519 | (char last-command-event) |
| 520 | (skeleton (or (assq char skeleton-pair-alist) |
| 521 | (assq char skeleton-pair-default-alist) |
| 522 | `(,char _ ,char)))) |
| 523 | (if (or (memq (char-syntax (preceding-char)) '(?\\ ?/)) |
| 524 | (and (not mark) |
| 525 | (or overwrite-mode |
| 526 | (if (not skeleton-pair-on-word) (looking-at "\\w")) |
| 527 | (funcall skeleton-pair-filter-function)))) |
| 528 | (self-insert-command (prefix-numeric-value arg)) |
| 529 | ;; Newlines not desirable for inserting pairs. See bug#16138. |
| 530 | (let ((skeleton-end-newline nil)) |
| 531 | (skeleton-insert (cons nil skeleton) (if mark -1))))))) |
| 532 | |
| 533 | \f |
| 534 | ;; A more serious example can be found in sh-script.el |
| 535 | ;; (defun mirror-mode () |
| 536 | ;; "This major mode is an amusing little example of paired insertion. |
| 537 | ;;All printable characters do a paired self insert, while the other commands |
| 538 | ;;work normally." |
| 539 | ;; (interactive) |
| 540 | ;; (kill-all-local-variables) |
| 541 | ;; (make-local-variable 'skeleton-pair) |
| 542 | ;; (make-local-variable 'skeleton-pair-on-word) |
| 543 | ;; (make-local-variable 'skeleton-pair-filter-function) |
| 544 | ;; (make-local-variable 'skeleton-pair-alist) |
| 545 | ;; (setq major-mode 'mirror-mode |
| 546 | ;; mode-name "Mirror" |
| 547 | ;; skeleton-pair-on-word t |
| 548 | ;; ;; in the middle column insert one or none if odd window-width |
| 549 | ;; skeleton-pair-filter-function (lambda () |
| 550 | ;; (if (>= (current-column) |
| 551 | ;; (/ (window-width) 2)) |
| 552 | ;; ;; insert both on next line |
| 553 | ;; (next-line 1) |
| 554 | ;; ;; insert one or both? |
| 555 | ;; (= (* 2 (1+ (current-column))) |
| 556 | ;; (window-width)))) |
| 557 | ;; ;; mirror these the other way round as well |
| 558 | ;; skeleton-pair-alist '((?) _ ?() |
| 559 | ;; (?] _ ?[) |
| 560 | ;; (?} _ ?{) |
| 561 | ;; (?> _ ?<) |
| 562 | ;; (?/ _ ?\\) |
| 563 | ;; (?\\ _ ?/) |
| 564 | ;; (?` ?` _ "''") |
| 565 | ;; (?' ?' _ "``")) |
| 566 | ;; ;; in this mode we exceptionally ignore the user, else it's no fun |
| 567 | ;; skeleton-pair t) |
| 568 | ;; (let ((map (make-vector 256 'skeleton-pair-insert-maybe)) |
| 569 | ;; (i 0)) |
| 570 | ;; (use-local-map `(keymap ,map)) |
| 571 | ;; (while (< i ? ) |
| 572 | ;; (aset map i nil) |
| 573 | ;; (aset map (+ i 128) nil) |
| 574 | ;; (setq i (1+ i)))) |
| 575 | ;; (run-mode-hooks 'mirror-mode-hook)) |
| 576 | |
| 577 | (provide 'skeleton) |
| 578 | |
| 579 | ;;; skeleton.el ends here |