lisp/skeleton.el

   1 ;;; skeleton.el --- Metalanguage for writing statement skeletons
   2 ;; Copyright (C) 1993 by Free Software Foundation, Inc.
   3
   4 ;; Author: Daniel Pfeiffer, fax (+49 69) 75 88 529, c/o <bonhoure@cict.fr>
   5 ;; Maintainer: FSF
   6 ;; Keywords: shell programming
   7
   8 ;; This file is part of GNU Emacs.
   9
  10 ;; GNU Emacs 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 ;; GNU Emacs 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, 675 Mass Ave, Cambridge, MA 02139, USA.
  23
  24 ;;; Commentary:
  25
  26 ;; A very concise metalanguage 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 ;; page 1:      statement skeleton metalanguage definition & interpreter
  35 ;; page 2:      paired insertion
  36 ;; page 3:      mirror-mode, an example for setting up paired insertion
  37
  38
  39 (defvar skeleton-transformation nil
  40   "*If non-nil, function applied to strings before they are inserted.
  41 It should take strings and characters and return them transformed, or nil
  42 which means no transformation.
  43 Typical examples might be `upcase' or `capitalize'.")
  44
  45 ; this should be a fourth argument to defvar
  46 (put 'skeleton-transformation 'variable-interactive
  47      "aTransformation function: ")
  48
  49
  50
  51 (defvar skeleton-subprompt
  52   (substitute-command-keys
  53    "RET, \\<minibuffer-local-map>\\[abort-recursive-edit] or \\[help-command]")
  54   "*Replacement for %s in prompts of recursive skeleton definitions.")
  55
  56
  57
  58 (defvar skeleton-debug nil
  59   "*If non-nil `define-skeleton' will override previous definition.")
  60
  61
  62
  63 ;;;###autoload
  64 (defmacro define-skeleton (command documentation &rest definition)
  65   "Define a user-configurable COMMAND that enters a statement skeleton.
  66 DOCUMENTATION is that of the command, while the variable of the same name,
  67 which contains the definition, has a documentation to that effect.
  68 PROMPT and ELEMENT ... are as defined under `skeleton-insert'."
  69   (if skeleton-debug
  70       (set command definition))
  71   (require 'backquote)
  72   (`(progn
  73       (defvar (, command) '(, definition)
  74         (, (concat "*Definition for the "
  75                    (symbol-name command)
  76                    " skeleton command.
  77 See function `skeleton-insert' for meaning."))  )
  78       (defun (, command) ()
  79         (, documentation)
  80         (interactive)
  81         ;; Don't use last-command to guarantee command does the same thing,
  82         ;; whatever other name it is given.
  83         (skeleton-insert (, command))))))
  84
  85
  86
  87 ;;;###autoload
  88 (defun skeleton-insert (definition &optional no-newline)
  89   "Insert the complex statement skeleton DEFINITION describes very concisely.
  90 If optional NO-NEWLINE is nil the skeleton will end on a line of its own.
  91
  92 DEFINITION is made up as (PROMPT ELEMENT ...).  PROMPT may be nil if not
  93 needed, a prompt-string or an expression for complex read functions.
  94
  95 If ELEMENT is a string or a character it gets inserted (see also
  96 `skeleton-transformation').  Other possibilities are:
  97
  98         \\n     go to next line and align cursor
  99         >       indent according to major mode
 100         <       undent tab-width spaces but not beyond beginning of line
 101         _       cursor after termination
 102         &       skip next ELEMENT if previous didn't move point
 103         |       skip next ELEMENT if previous moved point
 104         -num    delete num preceding characters
 105         resume: skipped, continue here if quit is signaled
 106         nil     skipped
 107
 108 ELEMENT may itself be DEFINITION with a PROMPT.  The user is prompted
 109 repeatedly for different inputs.  The DEFINITION is processed as often
 110 as the user enters a non-empty string.  \\[keyboard-quit] terminates
 111 skeleton insertion, but continues after `resume:' and positions at `_'
 112 if any.  If PROMPT in such a sub-definition contains a \".. %s ..\" it
 113 is replaced by `skeleton-subprompt'.
 114
 115 Other lisp-expressions are evaluated and the value treated as above.
 116 The following local variables are available:
 117
 118         str     first time: read a string prompting with PROMPT and insert it
 119                             if PROMPT is not a string it is evaluated instead
 120                 then: insert previously read string once more
 121         quit    non-nil when resume: section is entered by keyboard quit
 122         v1, v2  local variables for memorising anything you want"
 123   (let (modified opoint point resume: quit v1 v2)
 124     (skeleton-internal-list definition (car definition))
 125     (or no-newline
 126         (eolp)
 127         (newline)
 128         (indent-relative t))
 129     (if point
 130         (goto-char point))))
 131
 132
 133
 134 (defun skeleton-internal-read (str)
 135   (let ((minibuffer-help-form "\
 136 As long as you provide input you will insert another subskeleton.
 137
 138 If you enter the empty string, the loop inserting subskeletons is
 139 left, and the current one is removed as far as it has been entered.
 140
 141 If you quit, the current subskeleton is removed as far as it has been
 142 entered.  No more of the skeleton will be inserted, except maybe for a
 143 syntactically necessary termination."))
 144     (setq str (if (stringp str)
 145                   (read-string
 146                    (format str skeleton-subprompt))
 147                 (eval str))))
 148   (if (string= str "")
 149       (signal 'quit t)
 150     str))
 151
 152
 153 (defun skeleton-internal-list (definition &optional str recursive start line)
 154   (condition-case quit
 155       (progn
 156         (setq start (save-excursion (beginning-of-line) (point))
 157               column (current-column)
 158               line (buffer-substring start
 159                                      (save-excursion (end-of-line) (point)))
 160               str (list 'setq 'str
 161                         (if recursive
 162                             (list 'skeleton-internal-read (list 'quote str))
 163                           (list (if (stringp str)
 164                                     'read-string
 165                                   'eval)
 166                                 str))))
 167         (while (setq modified (eq opoint (point))
 168                      opoint (point)
 169                      definition (cdr definition))
 170           (skeleton-internal-1 (car definition)))
 171         ;; maybe continue loop
 172         recursive)
 173     (quit ;; remove the subskeleton as far as it has been shown
 174           (if (eq (cdr quit) 'recursive)
 175               ()
 176             ;; the subskeleton shouldn't have deleted outside current line
 177             (end-of-line)
 178             (delete-region start (point))
 179             (insert line)
 180             (move-to-column column))
 181           (if (eq (cdr quit) t)
 182               ;; empty string entered
 183               nil
 184             (while (if definition
 185                        (not (eq (car (setq definition (cdr definition)))
 186                                 'resume:))))
 187             (if definition
 188                 (skeleton-internal-list definition)
 189               ;; propagate signal we can't handle
 190               (if recursive (signal 'quit 'recursive)))))))
 191
 192
 193
 194 (defun skeleton-internal-1 (element)
 195   (cond ( (and (integerp element)
 196                (< element 0))
 197           (delete-char element))
 198         ( (char-or-string-p element)
 199           (insert (if skeleton-transformation
 200                       (funcall skeleton-transformation element)
 201                     element)) )
 202         ( (eq element '\n)              ; actually (eq '\n 'n)
 203           (newline)
 204           (indent-relative t) )
 205         ( (eq element '>)
 206           (indent-for-tab-command) )
 207         ( (eq element '<)
 208           (backward-delete-char-untabify (min tab-width (current-column))) )
 209         ( (eq element '_)
 210           (or point
 211               (setq point (point))) )
 212         ( (eq element '&)
 213           (if modified
 214               (setq definition (cdr definition))) )
 215         ( (eq element '|)
 216           (or modified
 217               (setq definition (cdr definition))) )
 218         ( (if (consp element)
 219               (or (stringp (car element))
 220                   (consp (car element))))
 221           (while (skeleton-internal-list element (car element) t)) )
 222         ( (null element) )
 223         ( (skeleton-internal-1 (eval element)) )))
 224
 225 \f
 226 ;; variables and command for automatically inserting pairs like () or ""
 227
 228 (defvar pair nil
 229   "*If this is nil pairing is turned off, no matter what else is set.
 230 Otherwise modes with `pair-insert-maybe' on some keys will attempt this.")
 231
 232
 233 (defvar pair-on-word nil
 234   "*If this is nil pairing is not attempted before or inside a word.")
 235
 236
 237 (defvar pair-filter (lambda ())
 238   "Attempt pairing if this function returns nil, before inserting.
 239 This allows for context-sensitive checking whether pairing is appropriate.")
 240
 241
 242 (defvar pair-alist ()
 243   "An override alist of pairing partners matched against
 244 `last-command-char'.  Each alist element, which looks like (ELEMENT
 245 ...), is passed to `skeleton-insert' with no prompt.  Variable `str'
 246 does nothing.
 247
 248 Elements might be (?` ?` _ \"''\"), (?\\( ?  _ \" )\") or (?{ \\n > _ \\n < ?}).")
 249
 250
 251
 252 ;;;###autoload
 253 (defun pair-insert-maybe (arg)
 254   "Insert the character you type ARG times.
 255
 256 With no ARG, if `pair' is non-nil, and if
 257 `pair-on-word' is non-nil or we are not before or inside a
 258 word, and if `pair-filter' returns nil, pairing is performed.
 259
 260 If a match is found in `pair-alist', that is inserted, else
 261 the defaults are used.  These are (), [], {}, <> and `' for the
 262 symmetrical ones, and the same character twice for the others."
 263   (interactive "*P")
 264   (if (or arg
 265           (not pair)
 266           (if (not pair-on-word) (looking-at "\\w"))
 267           (funcall pair-filter))
 268       (self-insert-command (prefix-numeric-value arg))
 269     (insert last-command-char)
 270     (if (setq arg (assq last-command-char pair-alist))
 271         ;; typed char is inserted, and car means no prompt
 272         (skeleton-insert arg t)
 273       (save-excursion
 274         (insert (or (cdr (assq last-command-char
 275                                '((?( . ?))
 276                                  (?[ . ?])
 277                                  (?{ . ?})
 278                                  (?< . ?>)
 279                                  (?` . ?'))))
 280                     last-command-char))))))
 281
 282 \f
 283
 284 ;;;###autoload
 285 ;; a more serious example can be found in shell-script.el
 286 (defun mirror-mode ()
 287   "This major mode is an amusing little example of paired insertion.
 288 All printable characters do a paired self insert, while the other commands
 289 work normally."
 290   (interactive)
 291   (kill-all-local-variables)
 292   (make-local-variable 'pair)
 293   (make-local-variable 'pair-on-word)
 294   (make-local-variable 'pair-filter)
 295   (make-local-variable 'pair-alist)
 296   (setq major-mode 'mirror-mode
 297         mode-name "Mirror"
 298         pair-on-word t
 299         ;; in the middle column insert one or none if odd window-width
 300         pair-filter (lambda ()
 301                       (if (>= (current-column)
 302                               (/ (window-width) 2))
 303                           ;; insert both on next line
 304                           (next-line 1)
 305                         ;; insert one or both?
 306                         (= (* 2 (1+ (current-column)))
 307                            (window-width))))
 308         ;; mirror these the other way round as well
 309         pair-alist '((?) _ ?()
 310                               (?] _ ?[)
 311                               (?} _ ?{)
 312                               (?> _ ?<)
 313                               (?/ _ ?\\)
 314                               (?\\ _ ?/)
 315                               (?` ?` _ "''")
 316                               (?' ?' _ "``"))
 317         ;; in this mode we exceptionally ignore the user, else it's no fun
 318         pair t)
 319   (let ((map (make-keymap))
 320         (i ? ))
 321     (use-local-map map)
 322     (setq map (car (cdr map)))
 323     (while (< i ?\^?)
 324       (aset map i 'pair-insert-maybe)
 325       (setq i (1+ i))))
 326   (run-hooks 'mirror-mode-hook))
 327
 328 ;; skeleton.el ends here