lisp/tempo.el

   1 ;;; tempo.el --- templates with hotspots
   2 ;; Copyright (C) 1994 Free Software Foundation, Inc.
   3
   4 ;; Author: David K}gedal <davidk@lysator.liu.se >
   5 ;; Created: 16 Feb 1994
   6 ;; Version: 1.1.1
   7 ;; Keywords: extensions, 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 2, or (at your option)
  14 ;; 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; see the file COPYING.  If not, write to
  23 ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; This file provides a simple way to define powerful templates, or
  28 ;; macros, if you wish. It is mainly intended for, but not limited to,
  29 ;; other programmers to be used for creating shortcuts for editing
  30 ;; certain kind of documents. It was originally written to be used by
  31 ;; a HTML editing mode written by Nelson Minar <nelson@reed.edu>, and
  32 ;; his html-helper-mode.el is probably the best example of how to use
  33 ;; this program.
  34
  35 ;; A template is defined as a list of items to be inserted in the
  36 ;; current buffer at point. Some of the items can be simple strings,
  37 ;; while other can control formatting or define special points of
  38 ;; interest in the inserted text.
  39
  40 ;; If a template defines a "point of interest" that point is inserted
  41 ;; in a buffer-local list of "points of interest" that the user can
  42 ;; jump between with the commands `tempo-backward-mark' and
  43 ;; `tempo-forward-mark'. If the template definer provides a prompt for
  44 ;; the point, and the variable `tempo-interactive' is non-nil, the
  45 ;; user will be prompted for a string to be inserted in the buffer,
  46 ;; using the minibuffer.
  47
  48 ;; The template can also define one point to be replaced with the
  49 ;; current region if the template command is called with a prefix (or
  50 ;; a non-nil argument).
  51
  52 ;; More flexible templates can be created by including lisp symbols,
  53 ;; which will be evaluated as variables, or lists, which will will be
  54 ;; evaluated as lisp expressions.
  55
  56 ;; See the documentation for tempo-define-template for the different
  57 ;; items that can be used to define a tempo template.
  58
  59 ;; One of the more powerful features of tempo templates are automatic
  60 ;; completion. With every template can be assigned a special tag that
  61 ;; should be recognized by `tempo-complete-tag' and expanded to the
  62 ;; complete template. By default the tags are added to a global list
  63 ;; of template tags, and are matched against the last word before
  64 ;; point. But if you assign your tags to a specific list, you can also
  65 ;; specify another method for matching text in the buffer against the
  66 ;; tags. In the HTML mode, for instance, the tags are matched against
  67 ;; the text between the last `<' and point.
  68
  69 ;; When defining a template named `foo', a symbol named
  70 ;; `tempo-template-foo' will be created whose value as a variable will
  71 ;; be the template definition, and its function value will be an
  72 ;; interactive function that inserts the template at the point.
  73
  74 ;; Full documentation for tempo.el can be found on the World Wide Web
  75 ;; at http://www.lysator.liu.se:7500/~davidk/tempo.html (not yet
  76 ;; completed)
  77
  78 ;; The latest tempo.el distribution can be fetched from
  79 ;; ftp.lysator.liu.se in the directory /pub/emacs
  80
  81 ;;; Code:
  82
  83 (provide 'tempo)
  84
  85 ;;; Variables
  86
  87 (defvar tempo-interactive nil
  88   "*Prompt user for strings in templates.
  89 If this variable is non-nil, `tempo-insert' prompts the
  90 user for text to insert in the templates")
  91
  92 (defvar tempo-insert-region nil
  93   "*Automatically insert current region when there is a `r' in the template
  94 If this variable is NIL, `r' elements will be treated just like `p'
  95 elements, unless the template function is given a prefix (or a non-nil
  96 argument). If this variable is non-NIL, the behaviour is reversed.")
  97
  98 (defvar tempo-show-completion-buffer t
  99   "*If non-NIL, show a buffer with possible completions, when only
 100 a partial completion can be found")
 101
 102 (defvar tempo-leave-completion-buffer nil
 103   "*If NIL, a completion buffer generated by \\[tempo-complete-tag]
 104 disappears at the next keypress; otherwise, it remains forever.")
 105
 106 (defvar tempo-insert-string-functions nil
 107   "List of functions to run when inserting a string.
 108 Each function is called with a single arg, STRING."  )
 109
 110 (defvar tempo-tags nil
 111   "An association list with tags and corresponding templates")
 112
 113 (defvar tempo-local-tags '((tempo-tags . nil))
 114   "A list of locally installed tag completion lists.
 115
 116 It is a association list where the car of every element is a symbol
 117 whose varable value is a template list. The cdr part, if non-nil, is a
 118 function or a regexp that defines the string to match. See the
 119 documentation for the function `tempo-complete-tag' for more info.
 120
 121 `tempo-tags' is always in the last position in this list.")
 122
 123 (defvar tempo-marks nil
 124   "A list of marks to jump to with `\\[tempo-forward-mark]' and `\\[tempo-backward-mark]'.")
 125
 126 (defvar tempo-default-match-finder "\\b\\([^\\b]*\\)\\="
 127   "The default regexp used to find the string to match against the tags.")
 128
 129 (defvar tempo-named-insertions nil
 130   "Temporary storage for named insertions")
 131
 132 ;; Make some variables local to every buffer
 133
 134 (make-variable-buffer-local 'tempo-marks)
 135 (make-variable-buffer-local 'tempo-local-tags)
 136
 137 ;;; Functions
 138
 139 ;;
 140 ;; tempo-define-template
 141
 142 (defun tempo-define-template (name elements &optional tag documentation taglist)
 143   "Define a template.
 144 This function creates a template variable `tempo-template-NAME' and an
 145 interactive function `tempo-template-NAME' that inserts the template
 146 at the point.  The created function is returned.
 147
 148 NAME is a string that contains the name of the template, ELEMENTS is a
 149 list of elements in the template, TAG is the tag used for completion,
 150 DOCUMENTATION is the documentation string for the insertion command
 151 created, and TAGLIST (a symbol) is the tag list that TAG (if provided)
 152 should be added to).  If TAGLIST is nil and TAG is non-nil, TAG is
 153 added to `tempo-tags'
 154
 155 The elements in ELEMENTS can be of several types:
 156
 157  - A string. It is sent to the hooks in `tempo-insert-string-functions',
 158    and the result is inserted.
 159  - The symbol 'p. This position is saved in `tempo-marks'.
 160  - The symbol 'r. If `tempo-insert' is called with ON-REGION non-nil
 161    the current region is placed here. Otherwise it works like 'p.
 162  - (p PROMPT <NAME>) If `tempo-interactive' is non-nil, the user is
 163    prompted in the minbuffer with PROMPT for a string to be inserted.
 164    If the optional parameter NAME is non-nil, the text is saved for
 165    later insertion with the `s' tag.
 166    If `tempo-interactive is nil, it works like 'p.
 167  - (r PROMPT) like the previous, but if `tempo-interactive' is nil
 168    and `tempo-insert' is called with ON-REGION non-nil, the current
 169    region is placed here.
 170  - (s NAME) Inserts text previously read with the (p ..) construct.
 171    Finds the insertion saved under NAME and inserts it. Acts like 'p
 172    if tempo-interactive is nil.
 173  - '& If there is only whitespace between the line start and point,
 174    nothing happens. Otherwise a newline is inserted.
 175  - '% If there is only whitespace between point and end-of-line
 176    nothing happens. Otherwise a newline is inserted.
 177  - 'n inserts a newline.
 178  - '> The line is indented using `indent-according-to-mode'. Note that
 179    you often should place this item after the text you want on the
 180    line.
 181  - 'n> inserts a newline and indents line.
 182  - nil. It is ignored.
 183  - Anything else. It is evaluated and the result is parsed again."
 184
 185   (let* ((template-name (intern (concat "tempo-template-"
 186                                        name)))
 187          (command-name template-name))
 188     (set template-name elements)
 189     (fset command-name (list 'lambda (list '&optional 'arg)
 190                              (or documentation
 191                                  (concat "Insert a " name "."))
 192                              (list 'interactive "*P")
 193                              (list 'tempo-insert-template (list 'quote
 194                                                                 template-name)
 195                                    (list 'if 'tempo-insert-region
 196                                          (list 'not 'arg) 'arg))))
 197     (and tag
 198          (tempo-add-tag tag template-name taglist))
 199     command-name))
 200
 201 ;;;
 202 ;;; tempo-insert-template
 203
 204 (defun tempo-insert-template (template on-region)
 205   "Insert a template.
 206 TEMPLATE is the template to be inserted.  If ON-REGION is non-nil the
 207 `r' elements are replaced with the current region."
 208   (and on-region
 209        (< (mark) (point))
 210        (exchange-point-and-mark))
 211   (save-excursion
 212     (tempo-insert-mark (point-marker))
 213     (mapcar 'tempo-insert
 214             (symbol-value template))
 215     (tempo-insert-mark (point-marker)))
 216   (tempo-forward-mark)
 217   (tempo-forget-insertions))
 218
 219 ;;;
 220 ;;; tempo-insert
 221
 222 (defun tempo-insert (element)
 223   "Insert a template element.
 224 Insert one element from a template. See documentation for
 225 `tempo-define-template' for the kind of elements possible."
 226   (cond ((stringp element) (tempo-process-and-insert-string element))
 227         ((and (consp element) (eq (car element) 'p))
 228          (tempo-insert-prompt (cdr element)))
 229         ((and (consp element) (eq (car element) 'r))
 230          (if on-region
 231              (exchange-point-and-mark)
 232            (tempo-insert-prompt (cdr element))))
 233         ((and (consp element) (eq (car element) 's))
 234          (if tempo-interactive
 235              (tempo-insert-named (cdr element))
 236            (tempo-insert-mark (point-marker))))
 237         ((eq element 'p) (tempo-insert-mark (point-marker)))
 238         ((eq element 'r) (if on-region
 239                              (exchange-point-and-mark)
 240                            (tempo-insert-mark (point-marker))))
 241         ((eq element '>) (indent-according-to-mode))
 242         ((eq element '&) (if (not (or (= (current-column) 0)
 243                                       (save-excursion
 244                                         (re-search-backward
 245                                          "^\\s-*\\=" nil t))))
 246                              (insert "\n")))
 247         ((eq element '%) (if (not (or (eolp)
 248                                       (save-excursion
 249                                         (re-search-forward
 250                                          "\\=\\s-*$" nil t))))
 251                              (insert "\n")))
 252         ((eq element 'n) (insert "\n"))
 253         ((eq element 'n>) (insert "\n") (indent-according-to-mode))
 254         ((null element))
 255         (t (tempo-insert (eval element)))))
 256
 257 ;;;
 258 ;;; tempo-insert-prompt
 259
 260 (defun tempo-insert-prompt (prompt)
 261   "Prompt for a text string and insert it in the current buffer.
 262 If the variable `tempo-interactive' is non-nil the user is prompted
 263 for a string in the minibuffer, which is then inserted in the current
 264 buffer. If `tempo-interactive' is nil, the current point is placed on
 265 `tempo-mark'.
 266
 267 PROMPT is the prompt string or a list containing the prompt string and
 268 a name to save the inserted text under."
 269   (if tempo-interactive
 270       (let ((prompt-string (if (listp prompt)
 271                                (car prompt)
 272                              prompt))
 273             (save-name (and (listp prompt) (nth 1 prompt)))
 274             inserted-text)
 275
 276         (progn
 277           (setq inserted-text (read-string prompt-string))
 278           (insert inserted-text)
 279           (if save-name
 280               (tempo-remember-insertion save-name inserted-text))))
 281     (tempo-insert-mark (point-marker))))
 282
 283 ;;;
 284 ;;; tempo-remember-insertion
 285
 286 (defun tempo-remember-insertion (save-name string)
 287   "Save the text in STRING under the name SAVE-NAME for later retrieval."
 288   (setq tempo-named-insertions (cons (cons save-name string)
 289                                      tempo-named-insertions)))
 290
 291 ;;;
 292 ;;; tempo-forget-insertions
 293
 294 (defun tempo-forget-insertions ()
 295   "Forget all the saved named insertions."
 296   (setq tempo-named-insertions nil))
 297
 298 ;;;
 299 ;;; tempo-insert-named
 300
 301 (defun tempo-insert-named (elt)
 302   "Insert the previous insertion saved under a named specified in ELT.
 303 The name is in the car of ELT."
 304   (let* ((name (car elt))
 305          (insertion (cdr (assq name tempo-named-insertions))))
 306     (if insertion
 307         (insert insertion)
 308       (error "Named insertion not found"))))
 309
 310 ;;;
 311 ;;; tempo-process-and-insert-string
 312
 313 (defun tempo-process-and-insert-string (string)
 314   "Insert a string from a template.
 315 Run a string through the preprocessors in `tempo-insert-string-functions'
 316 and insert the results."
 317   (cond ((null tempo-insert-string-functions)
 318          nil)
 319         ((symbolp tempo-insert-string-functions)
 320          (setq string
 321                (apply tempo-insert-string-functions (list string))))
 322         ((listp tempo-insert-string-functions)
 323          (mapcar (function (lambda (fn)
 324                              (setq string (apply fn string))))
 325                  tempo-insert-string-functions))
 326         (t
 327          (error "Bogus value in tempo-insert-string-functions: %s"
 328                 tempo-insert-string-functions)))
 329   (insert string))
 330
 331 ;;;
 332 ;;; tempo-insert-mark
 333
 334 (defun tempo-insert-mark (mark)
 335   "Insert a mark `tempo-marks' while keeping it sorted"
 336   (cond ((null tempo-marks) (setq tempo-marks (list mark)))
 337         ((< mark (car tempo-marks)) (setq tempo-marks (cons mark tempo-marks)))
 338         (t (let ((lp tempo-marks))
 339              (while (and (cdr lp)
 340                          (<= (car (cdr lp)) mark))
 341                (setq lp (cdr lp)))
 342              (if (not (= mark (car lp)))
 343                  (setcdr lp (cons mark (cdr lp))))))))
 344
 345 ;;;
 346 ;;; tempo-forward-mark
 347
 348 (defun tempo-forward-mark ()
 349   "Jump to the next mark in `tempo-forward-mark-list'."
 350   (interactive)
 351   (let ((next-mark (catch 'found
 352                      (mapcar
 353                       (function
 354                        (lambda (mark)
 355                          (if (< (point) mark)
 356                              (throw 'found mark))))
 357                       tempo-marks)
 358                      ;; return nil if not found
 359                      nil)))
 360     (if next-mark
 361         (goto-char next-mark))))
 362
 363 ;;;
 364 ;;; tempo-backward-mark
 365
 366 (defun tempo-backward-mark ()
 367   "Jump to the previous mark in `tempo-back-mark-list'."
 368   (interactive)
 369   (let ((prev-mark (catch 'found
 370                      (let (last)
 371                        (mapcar
 372                         (function
 373                          (lambda (mark)
 374                            (if (<= (point) mark)
 375                                (throw 'found last))
 376                            (setq last mark)))
 377                         tempo-marks)
 378                        last))))
 379     (if prev-mark
 380         (goto-char prev-mark))))
 381
 382 ;;;
 383 ;;; tempo-add-tag
 384
 385 (defun tempo-add-tag (tag template &optional tag-list)
 386   "Add a template tag.
 387
 388 Add the TAG, that should complete to TEMPLATE to the list in TAG-LIST,
 389 or to `tempo-tags' if TAG-LIST is nil."
 390
 391   (interactive "sTag: \nCTemplate: ")
 392   (if (null tag-list)
 393       (setq tag-list 'tempo-tags))
 394   (if (not (assoc tag (symbol-value tag-list)))
 395       (set tag-list (cons (cons tag template) (symbol-value tag-list)))))
 396
 397 ;;;
 398 ;;; tempo-use-tag-list
 399
 400 (defun tempo-use-tag-list (tag-list &optional completion-function)
 401   "Install TAG-LIST to be used for template completion in the current buffer.
 402
 403 TAG-LIST is a symbol whose variable value is a tag list created with
 404 `tempo-add-tag' and COMPLETION-FUNCTION is an optional function or
 405 string that is used by `\\[tempo-complete-tag]' to find a string to
 406 match the tag against.
 407
 408 If COMPLETION-FUNCTION is a string, it should contain a regular
 409 expression with at least one \\( \\) pair. When searching for tags,
 410 `tempo-complete-tag' calls `re-search-backward' with this string, and
 411 the string between the first \\( and \\) is used for matching against
 412 each string in the tag list. If one is found, the whole text between
 413 the first \\( and the point is replaced with the inserted template.
 414
 415 You will probably want to include \\ \= at the end of the regexp to make
 416 sure that the string is matched only against text adjacent to the
 417 point.
 418
 419 If COPMLETION-FUNCTION is a symbol, it should be a function that
 420 returns a cons cell of the form (STRING . POS), where STRING is the
 421 string used for matching and POS is the buffer position after which
 422 text should be replaced with a template."
 423
 424   (let ((old (assq tag-list tempo-local-tags)))
 425     (if old
 426         (setcdr old completion-function)
 427       (setq tempo-local-tags (cons (cons tag-list completion-function)
 428                                    tempo-local-tags)))))
 429
 430 ;;;
 431 ;;; tempo-find-match-string
 432
 433 (defun tempo-find-match-string (finder)
 434   "Find a string to be matched against a tag list.
 435
 436 FINDER is a function or a string. Returns (STRING . POS)."
 437   (cond ((stringp finder)
 438          (save-excursion
 439            (re-search-backward finder nil t))
 440          (cons (buffer-substring (match-beginning 1) (1+ (match-end 1)))
 441                (match-beginning 1)))
 442         (t
 443          (funcall finder))))
 444
 445 ;;;
 446 ;;; tempo-complete-tag
 447
 448 (defun tempo-complete-tag (&optional silent)
 449   "Look for a tag and expand it.
 450
 451 It goes through the tag lists in `tempo-local-tags' (this includes
 452 `tempo-tags') and for each list it uses the corresponding match-finder
 453 function, or `tempo-default-match-finder' if none is given, and tries
 454 to match the match string against the tags in the list using
 455 `try-completion'. If none is found it proceeds to the next list until
 456 one is found. If a partial completion is found, it is replaced by the
 457 template if it can be completed uniquely, or completed as far as
 458 possible.
 459
 460 When doing partial completion, only tags in the currently examined
 461 list are considered, so if you provide similar tags in different lists
 462 in `tempo-local-tags', the result may not be desirable.
 463
 464 If no match is found or a partial match is found, and SILENT is
 465 non-nil, the function will give a signal.
 466
 467 If tempo-show-completion-buffer is non-NIL, a buffer containing
 468 possible completions is displayed when a partial completion is found."
 469
 470   ;; This function is really messy. Some cleaning up is necessary.
 471   (interactive)
 472   (if (catch 'completed
 473         (mapcar
 474          (function
 475           (lambda (tag-list-a)
 476             (let* ((tag-list (symbol-value(car tag-list-a)))
 477                    (match-string-finder (or (cdr tag-list-a)
 478                                             tempo-default-match-finder))
 479                    (match-info (tempo-find-match-string match-string-finder))
 480                    (match-string (car match-info))
 481                    (match-start (cdr match-info))
 482                    (compl (or (cdr (assoc match-string tag-list))
 483                               (try-completion match-string
 484                                               tag-list))))
 485
 486               (if compl                 ;any match
 487                   (delete-region match-start (point)))
 488
 489               (cond
 490                ((null compl)            ; No match
 491                 nil)
 492                ((symbolp compl)         ; ??
 493                 (tempo-insert-template compl nil)
 494                 (throw 'completed t))
 495                ((eq compl t)            ; Exact, sole match
 496                 (tempo-insert-template (cdr (assoc match-string tag-list))
 497                                        nil)
 498                 (throw 'completed t))
 499                ((stringp compl)         ; (partial) completion found
 500                 (let ((compl2 (assoc compl tag-list)))
 501                   (if compl2
 502                       (tempo-insert-template (cdr compl2) nil)
 503                     (insert compl)
 504                     (if t ;(string= match-string compl)
 505                         (if tempo-show-completion-buffer
 506                             (tempo-display-completions match-string
 507                                                        tag-list)
 508                           (if (not silent)
 509                               (ding))))))
 510                 (throw 'completed t))))))
 511          tempo-local-tags)
 512         ;; No completion found. Return nil
 513         nil)
 514       ;; Do nothing if a completion was found
 515       t
 516     ;; No completion was found
 517     (if (not silent)
 518         (ding))
 519     nil))
 520
 521 ;;;
 522 ;;; tempo-display-completions
 523
 524 (defun tempo-display-completions (string tag-list)
 525   "Show a buffer containing possible completions for STRING."
 526   (if tempo-leave-completion-buffer
 527       (with-output-to-temp-buffer "*Completions*"
 528         (display-completion-list
 529          (all-completions string tag-list)))
 530     (save-window-excursion
 531       (with-output-to-temp-buffer "*Completions*"
 532         (display-completion-list
 533          (all-completions string tag-list)))
 534       (sit-for 32767))))
 535
 536 ;;; tempo.el ends here