lisp/tempo.el

   1 ;;; tempo.el --- Flexible template insertion
   2
   3 ;; Copyright (C) 1994, 1995 Free Software Foundation, Inc.
   4
   5 ;; Author: David K}gedal <davidk@lysator.liu.se >
   6 ;; Created: 16 Feb 1994
   7 ;; K}gedal's last version number: 1.2.4
   8 ;; Keywords: extensions, languages, tools
   9
  10 ;; This file is part of GNU Emacs.
  11
  12 ;; GNU Emacs is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 2, or (at your option)
  15 ;; any later version.
  16
  17 ;; GNU Emacs is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; You should have received a copy of the GNU General Public License
  23 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  24 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  25 ;; Boston, MA 02111-1307, USA.
  26
  27 ;;; Commentary:
  28
  29 ;; This file provides a simple way to define powerful templates, or
  30 ;; macros, if you wish. It is mainly intended for, but not limited to,
  31 ;; other programmers to be used for creating shortcuts for editing
  32 ;; certain kind of documents. It was originally written to be used by
  33 ;; a HTML editing mode written by Nelson Minar <nelson@santafe.edu>,
  34 ;; and his html-helper-mode.el is probably the best example of how to
  35 ;; use this program.
  36
  37 ;; A template is defined as a list of items to be inserted in the
  38 ;; current buffer at point. Some of the items can be simple strings,
  39 ;; while other can control formatting or define special points of
  40 ;; interest in the inserted text.
  41
  42 ;; If a template defines a "point of interest" that point is inserted
  43 ;; in a buffer-local list of "points of interest" that the user can
  44 ;; jump between with the commands `tempo-backward-mark' and
  45 ;; `tempo-forward-mark'. If the template definer provides a prompt for
  46 ;; the point, and the variable `tempo-interactive' is non-nil, the
  47 ;; user will be prompted for a string to be inserted in the buffer,
  48 ;; using the minibuffer.
  49
  50 ;; The template can also define one point to be replaced with the
  51 ;; current region if the template command is called with a prefix (or
  52 ;; a non-nil argument).
  53
  54 ;; More flexible templates can be created by including lisp symbols,
  55 ;; which will be evaluated as variables, or lists, which will will be
  56 ;; evaluated as lisp expressions.
  57
  58 ;; See the documentation for tempo-define-template for the different
  59 ;; items that can be used to define a tempo template.
  60
  61 ;; One of the more powerful features of tempo templates are automatic
  62 ;; completion. With every template can be assigned a special tag that
  63 ;; should be recognized by `tempo-complete-tag' and expanded to the
  64 ;; complete template. By default the tags are added to a global list
  65 ;; of template tags, and are matched against the last word before
  66 ;; point. But if you assign your tags to a specific list, you can also
  67 ;; specify another method for matching text in the buffer against the
  68 ;; tags. In the HTML mode, for instance, the tags are matched against
  69 ;; the text between the last `<' and point.
  70
  71 ;; When defining a template named `foo', a symbol named
  72 ;; `tempo-template-foo' will be created whose value as a variable will
  73 ;; be the template definition, and its function value will be an
  74 ;; interactive function that inserts the template at the point.
  75
  76 ;; The latest tempo.el distribution can be fetched from
  77 ;; ftp.lysator.liu.se in the directory /pub/emacs
  78
  79 ;; There is also a WWW page at
  80 ;; http://www.lysator.liu.se/~davidk/elisp/ which has some information
  81
  82 ;;; Known bugs:
  83
  84 ;; If the 'o is the first element in a template, strange things can
  85 ;; happen when the template is inserted at the beginning of a
  86 ;; line. This is due to strange behaviour in open-line. But it should
  87 ;; be easily avoided.
  88
  89 ;; The 'o tag is also a problem when including the region. This will
  90 ;; be looked into.
  91
  92 ;; Clicking mouse-2 in the completion buffer gives strange results.
  93
  94 ;; There is a bug in some emacs versions that prevents completion from
  95 ;; working. If it doesn't work for you, send me a note indicating your
  96 ;; emacs version and your problems.
  97
  98 ;;; Contributors:
  99
 100 ;; These people have given me important feedback and new ideas for
 101 ;; tempo.el. Thanks.
 102
 103 ;; Nelson Minar <nelson@santafe.edu>
 104 ;; Richard Stallman <rms@gnu.ai.mit.edu>
 105 ;; Lars Lindberg <Lars.Lindberg@sypro.cap.se>
 106 ;; Glen Whitney <Glen.Whitney@math.lsa.umich.edu>
 107
 108 ;;; Code:
 109
 110 ;; (provide 'tempo)
 111
 112 ;;; User options
 113
 114 (defvar tempo-interactive nil
 115   "*Prompt user for strings in templates.
 116 If this variable is non-nil, `tempo-insert' prompts the
 117 user for text to insert in the templates")
 118
 119 (defvar tempo-insert-region nil
 120   "*Automatically insert current region when there is a `r' in the template
 121 If this variable is NIL, `r' elements will be treated just like `p'
 122 elements, unless the template function is given a prefix (or a non-nil
 123 argument). If this variable is non-NIL, the behaviour is reversed.
 124
 125 In Transient Mark mode, this option is unused.")
 126
 127 (defvar tempo-show-completion-buffer t
 128   "*If non-NIL, show a buffer with possible completions, when only
 129 a partial completion can be found")
 130
 131 (defvar tempo-leave-completion-buffer nil
 132   "*If NIL, a completion buffer generated by \\[tempo-complete-tag]
 133 disappears at the next keypress; otherwise, it remains forever.")
 134
 135 ;;; Internal variables
 136
 137 (defvar tempo-insert-string-functions nil
 138   "List of functions to run when inserting a string.
 139 Each function is called with a single arg, STRING and should return
 140 another string. This could be used for making all strings upcase by
 141 setting it to '(upcase), for example.")
 142
 143 (defvar tempo-tags nil
 144   "An association list with tags and corresponding templates")
 145
 146 (defvar tempo-local-tags '((tempo-tags . nil))
 147   "A list of locally installed tag completion lists.
 148 It is a association list where the car of every element is a symbol
 149 whose variable value is a template list. The cdr part, if non-nil, is a
 150 function or a regexp that defines the string to match. See the
 151 documentation for the function `tempo-complete-tag' for more info.
 152
 153 `tempo-tags' is always in the last position in this list.")
 154
 155 (defvar tempo-collection nil
 156   "A collection of all the tags defined for the current buffer.")
 157
 158 (defvar tempo-dirty-collection t
 159   "Indicates if the tag collection needs to be rebuilt.")
 160
 161 (defvar tempo-marks nil
 162   "A list of marks to jump to with `\\[tempo-forward-mark]' and `\\[tempo-backward-mark]'.")
 163
 164 (defvar tempo-match-finder "\\b\\([^\\b]+\\)\\="
 165   "The regexp or function used to find the string to match against tags.
 166
 167 If `tempo-match-finder is a string, it should contain a regular
 168 expression with at least one \\( \\) pair. When searching for tags,
 169 `tempo-complete-tag' calls `re-search-backward' with this string, and
 170 the string between the first \\( and \\) is used for matching against
 171 each string in the tag list. If one is found, the whole text between
 172 the first \\( and the point is replaced with the inserted template.
 173
 174 You will probably want to include \\ \= at the end of the regexp to
 175 make sure that the string is matched only against text adjacent to the
 176 point.
 177
 178 If `tempo-match-finder' is a symbol, it should be a function that
 179 returns a pair of the form (STRING . POS), where STRING is the string
 180 used for matching and POS is the buffer position after which text
 181 should be replaced with a template.")
 182
 183 (defvar tempo-user-elements nil
 184   "Element handlers for user-defined elements.
 185 A list of symbols which are bound to functions that take one argument.
 186 This function should return something to be sent to `tempo-insert' if
 187 it recognizes the argument, and NIL otherwise")
 188
 189 (defvar tempo-named-insertions nil
 190   "Temporary storage for named insertions")
 191
 192 (defvar tempo-region-start (make-marker)
 193   "Region start when inserting around the region")
 194
 195 (defvar tempo-region-stop (make-marker)
 196   "Region stop when inserting around the region")
 197
 198 ;; Make some variables local to every buffer
 199
 200 (make-variable-buffer-local 'tempo-marks)
 201 (make-variable-buffer-local 'tempo-local-tags)
 202 (make-variable-buffer-local 'tempo-match-finder)
 203 (make-variable-buffer-local 'tempo-collection)
 204 (make-variable-buffer-local 'tempo-dirty-collection)
 205
 206 ;;; Functions
 207
 208 ;;; First some useful functions and macros
 209
 210 (defun tempo-mapc (fun lst)
 211   (if (null lst) nil
 212     (funcall fun (car lst))
 213     (tempo-mapc fun (cdr lst))))
 214
 215 (defmacro tempo-dolist (il &rest forms)
 216   (let ((i (car il))
 217         (l (car (cdr il))))
 218     (list 'tempo-mapc
 219           (list 'function (append (list 'lambda
 220                                         (list i))
 221                                   forms))
 222           l)))
 223 (put 'tempo-dolist 'lisp-indent-function 1)
 224
 225 ;;
 226 ;; tempo-define-template
 227
 228 (defun tempo-define-template (name elements &optional tag documentation taglist)
 229   "Define a template.
 230 This function creates a template variable `tempo-template-NAME' and an
 231 interactive function `tempo-template-NAME' that inserts the template
 232 at the point.  The created function is returned.
 233
 234 NAME is a string that contains the name of the template, ELEMENTS is a
 235 list of elements in the template, TAG is the tag used for completion,
 236 DOCUMENTATION is the documentation string for the insertion command
 237 created, and TAGLIST (a symbol) is the tag list that TAG (if provided)
 238 should be added to).  If TAGLIST is nil and TAG is non-nil, TAG is
 239 added to `tempo-tags'
 240
 241 The elements in ELEMENTS can be of several types:
 242
 243  - A string. It is sent to the hooks in `tempo-insert-string-functions',
 244    and the result is inserted.
 245  - The symbol 'p. This position is saved in `tempo-marks'.
 246  - The symbol 'r. If `tempo-insert' is called with ON-REGION non-nil
 247    the current region is placed here. Otherwise it works like 'p.
 248  - (p PROMPT <NAME> <NOINSERT>) If `tempo-interactive' is non-nil, the
 249    user is prompted in the minbuffer with PROMPT for a string to be
 250    inserted. If the optional parameter NAME is non-nil, the text is
 251    saved for later insertion with the `s' tag. If there already is
 252    something saved under NAME that value is used instead and no
 253    prompting is made. If NOINSERT is provided and non-nil, nothing is
 254    inserted, but text is still saved when a NAME is provided. For
 255    clarity, the symbol 'noinsert should be used as argument.
 256  - (P PROMPT <NAME> <NOINSERT>) Works just like the previous tag, but
 257    forces tempo-interactive to be true.
 258  - (r PROMPT <NAME> <NOINSERT>) like the previous, but if
 259    `tempo-interactive' is nil and `tempo-insert' is called with
 260    ON-REGION non-nil, the current region is placed here. This usually
 261    happens when you call the template function with a prefix argument.
 262  - (s NAME) Inserts text previously read with the (p ..) construct.
 263    Finds the insertion saved under NAME and inserts it. Acts like 'p
 264    if tempo-interactive is nil.
 265  - '& If there is only whitespace between the line start and point,
 266    nothing happens. Otherwise a newline is inserted.
 267  - '% If there is only whitespace between point and end-of-line
 268    nothing happens. Otherwise a newline is inserted.
 269  - 'n inserts a newline.
 270  - '> The line is indented using `indent-according-to-mode'. Note that
 271    you often should place this item after the text you want on the
 272    line.
 273  - 'r> Like r, but it also indents the region.
 274  - 'n> Inserts a newline and indents line.
 275  - 'o Like '% but leaves the point before the newline.
 276  - nil. It is ignored.
 277  - Anything else. It is evaluated and the result is treated as an
 278    element to be inserted. One additional tag is useful for these
 279    cases. If an expression returns a list '(l foo bar), the elements
 280    after 'l will be inserted according to the usual rules. This makes
 281    it possible to return several elements from one expression."
 282
 283   (let* ((template-name (intern (concat "tempo-template-"
 284                                        name)))
 285          (command-name template-name))
 286     (set template-name elements)
 287     (fset command-name (list 'lambda (list '&optional 'arg)
 288                              (or documentation
 289                                  (concat "Insert a " name "."))
 290                              (list 'interactive "*P")
 291                              (list 'tempo-insert-template (list 'quote
 292                                                                 template-name)
 293                                    (list 'if 'tempo-insert-region
 294                                          (list 'not 'arg) 'arg))))
 295     (and tag
 296          (tempo-add-tag tag template-name taglist))
 297     command-name))
 298
 299 ;;;
 300 ;;; tempo-insert-template
 301
 302 (defun tempo-insert-template (template on-region)
 303   "Insert a template.
 304 TEMPLATE is the template to be inserted.  If ON-REGION is non-nil the
 305 `r' elements are replaced with the current region. In Transient Mark
 306 mode, ON-REGION is ignored and assumed true if the region is active."
 307   (unwind-protect
 308       (progn
 309         (if (or (and (boundp 'transient-mark-mode) ; For Emacs
 310                      transient-mark-mode
 311                      mark-active)
 312                 (and (boundp 'zmacs-regions) ; For XEmacs
 313                      zmacs-regions (mark)))
 314             (setq on-region t))
 315         (and on-region
 316              (set-marker tempo-region-start (min (mark) (point)))
 317              (set-marker tempo-region-stop (max (mark) (point))))
 318         (if on-region
 319             (goto-char tempo-region-start))
 320         (save-excursion
 321           (tempo-insert-mark (point-marker))
 322           (mapcar (function (lambda (elt)
 323                               (tempo-insert elt on-region)))
 324                   (symbol-value template))
 325           (tempo-insert-mark (point-marker)))
 326         (tempo-forward-mark))
 327     (tempo-forget-insertions)
 328     ;; Should I check for zmacs here too???
 329     (and (boundp 'transient-mark-mode)
 330          transient-mark-mode
 331          (deactivate-mark))))
 332
 333 ;;;
 334 ;;; tempo-insert
 335
 336 (defun tempo-insert (element on-region)
 337   "Insert a template element.
 338 Insert one element from a template. If ON-REGION is non-nil the `r'
 339 elements are replaced with the current region.
 340
 341 See documentation for `tempo-define-template' for the kind of elements
 342 possible."
 343   (cond ((stringp element) (tempo-process-and-insert-string element))
 344         ((and (consp element)
 345               (eq (car element) 'p)) (tempo-insert-prompt-compat
 346                                       (cdr element)))
 347         ((and (consp element)
 348               (eq (car element) 'P)) (let ((tempo-interactive t))
 349                                        (tempo-insert-prompt-compat
 350                                         (cdr element))))
 351 ;;;     ((and (consp element)
 352 ;;;           (eq (car element) 'v)) (tempo-save-named
 353 ;;;                                   (nth 1 element)
 354 ;;;                                   nil
 355 ;;;                                   (nth 2 element)))
 356         ((and (consp element)
 357               (eq (car element) 'r)) (if on-region
 358                                          (goto-char tempo-region-stop)
 359                                        (tempo-insert-prompt-compat
 360                                         (cdr element))))
 361         ((and (consp element)
 362               (eq (car element) 's)) (tempo-insert-named (car (cdr element))))
 363         ((and (consp element)
 364               (eq (car element) 'l)) (mapcar (function
 365                                               (lambda (elt)
 366                                                 (tempo-insert elt on-region)))
 367                                              (cdr element)))
 368         ((eq element 'p) (tempo-insert-mark (point-marker)))
 369         ((eq element 'r) (if on-region
 370                              (goto-char tempo-region-stop)
 371                            (tempo-insert-mark (point-marker))))
 372         ((eq element 'r>) (if on-region
 373                               (progn
 374                                 (goto-char tempo-region-stop)
 375                                 (indent-region (mark) (point) nil))
 376                             (tempo-insert-mark (point-marker))))
 377         ((eq element '>) (indent-according-to-mode))
 378         ((eq element '&) (if (not (or (= (current-column) 0)
 379                                       (save-excursion
 380                                         (re-search-backward
 381                                          "^\\s-*\\=" nil t))))
 382                              (insert "\n")))
 383         ((eq element '%) (if (not (or (eolp)
 384                                       (save-excursion
 385                                         (re-search-forward
 386                                          "\\=\\s-*$" nil t))))
 387                              (insert "\n")))
 388         ((eq element 'n) (insert "\n"))
 389         ((eq element 'n>) (insert "\n") (indent-according-to-mode))
 390         ;; Bug: If the 'o is the first element in a template, strange
 391         ;; things can happen when the template is inserted at the
 392         ;; beginning of a line.
 393         ((eq element 'o) (if (not (or on-region
 394                                       (eolp)
 395                                       (save-excursion
 396                                         (re-search-forward
 397                                          "\\=\\s-*$" nil t))))
 398                              (open-line 1)))
 399         ((null element))
 400         (t (tempo-insert (or (tempo-is-user-element element)
 401                              (eval element))
 402                          on-region))))
 403
 404 ;;;
 405 ;;; tempo-insert-prompt
 406
 407 (defun tempo-insert-prompt-compat (prompt)
 408   "Compatibility hack for tempo-insert-prompt.
 409 PROMPT can be either a prompt string, or a list of arguments to
 410 tempo-insert-prompt, or nil."
 411   (if (consp prompt)                    ; not NIL either
 412       (apply 'tempo-insert-prompt prompt)
 413     (tempo-insert-prompt prompt)))
 414
 415 (defun tempo-insert-prompt (prompt &optional save-name no-insert)
 416   "Prompt for a text string and insert it in the current buffer.
 417 If the variable `tempo-interactive' is non-nil the user is prompted
 418 for a string in the minibuffer, which is then inserted in the current
 419 buffer. If `tempo-interactive' is nil, the current point is placed on
 420 `tempo-mark'.
 421
 422 PROMPT is the prompt string, SAVE-NAME is a name to save the inserted
 423 text under. If the optional argument NO-INSERT is non-nil, no text i
 424 inserted. This can be useful when there is a SAVE-NAME.
 425
 426 If there already is a value for SAVE-NAME, it is used and the user is
 427 never prompted."
 428   (let (insertion
 429         (previous (and save-name
 430                        (tempo-lookup-named save-name))))
 431     (cond
 432      ;; Insert  previous value, unless no-insert is non-nil
 433      ((and previous
 434            (not no-insert))
 435       (tempo-insert-named save-name)) ; A double lookup here, but who
 436                                       ; cares
 437      ;; If no-insert is non-nil, don't insert the previous value. Just
 438      ;; keep it
 439      (previous
 440       nil)
 441      ;; No previous value. Prompt or insert mark
 442      (tempo-interactive
 443       (if (not (stringp prompt))
 444           (error "tempo: The prompt (%s) is not a string" prompt))
 445       (setq insertion (read-string prompt))
 446       (or no-insert
 447           (insert insertion))
 448       (if save-name
 449           (tempo-save-named save-name insertion)))
 450      (t
 451       (tempo-insert-mark (point-marker))))))
 452
 453 ;;;
 454 ;;; tempo-is-user-element
 455
 456 (defun tempo-is-user-element (element)
 457   "Tries all the user-defined element handlers in
 458 `tempo-user-elements'"
 459   ;; Sigh... I need (some list)
 460   (catch 'found
 461     (mapcar (function (lambda (handler)
 462                         (let ((result (funcall handler element)))
 463                           (if result (throw 'found result)))))
 464             tempo-user-elements)
 465     (throw 'found nil)))
 466
 467 ;;;
 468 ;;; tempo-forget-insertions
 469
 470 (defun tempo-forget-insertions ()
 471   "Forget all the saved named insertions."
 472   (setq tempo-named-insertions nil))
 473
 474 ;;;
 475 ;;; tempo-save-named
 476
 477 (defun tempo-save-named (name data)     ; Had an optional prompt for 'v
 478   "Save some data for later insertion
 479 The contents of DATA is saved under the name NAME.
 480
 481 The data can later be retrieved with `tempo-lookup-named'.
 482
 483 This function returns nil, so it can be used in a template without
 484 inserting anything."
 485   (setq tempo-named-insertions
 486         (cons (cons name data)
 487               tempo-named-insertions))
 488   nil)
 489
 490 ;;;
 491 ;;; tempo-lookup-named
 492
 493 (defun tempo-lookup-named (name)
 494   "Lookup some saved data under the name NAME.
 495 Returns the data if NAME was found, and nil otherwise."
 496   (cdr (assq name tempo-named-insertions)))
 497
 498 ;;;
 499 ;;; tempo-insert-named
 500
 501 (defun tempo-insert-named (name)
 502   "Insert the previous insertion saved under a named specified in NAME.
 503 If there is no such name saved, a tempo mark is inserted.
 504
 505 Note that if the data is a string, it will not be run through the string
 506 processor."
 507   (let* ((insertion (tempo-lookup-named name)))
 508     (cond ((null insertion)
 509            (tempo-insert-mark (point-marker)))
 510           ((stringp insertion)
 511            (insert insertion))
 512           (t
 513            (tempo-insert insertion nil)))))
 514
 515
 516 ;;;
 517 ;;; tempo-process-and-insert-string
 518
 519 (defun tempo-process-and-insert-string (string)
 520   "Insert a string from a template.
 521 Run a string through the preprocessors in `tempo-insert-string-functions'
 522 and insert the results."
 523   (cond ((null tempo-insert-string-functions)
 524          nil)
 525         ((symbolp tempo-insert-string-functions)
 526          (setq string
 527                (funcall tempo-insert-string-functions string)))
 528         ((listp tempo-insert-string-functions)
 529          (tempo-dolist (fn tempo-insert-string-functions)
 530            (setq string (funcall fn string))))
 531         (t
 532          (error "Bogus value in tempo-insert-string-functions: %s"
 533                 tempo-insert-string-functions)))
 534   (insert string))
 535
 536 ;;;
 537 ;;; tempo-insert-mark
 538
 539 (defun tempo-insert-mark (mark)
 540   "Insert a mark `tempo-marks' while keeping it sorted"
 541   (cond ((null tempo-marks) (setq tempo-marks (list mark)))
 542         ((< mark (car tempo-marks)) (setq tempo-marks (cons mark tempo-marks)))
 543         (t (let ((lp tempo-marks))
 544              (while (and (cdr lp)
 545                          (<= (car (cdr lp)) mark))
 546                (setq lp (cdr lp)))
 547              (if (not (= mark (car lp)))
 548                  (setcdr lp (cons mark (cdr lp))))))))
 549
 550 ;;;
 551 ;;; tempo-forward-mark
 552
 553 (defun tempo-forward-mark ()
 554   "Jump to the next mark in `tempo-forward-mark-list'."
 555   (interactive)
 556   (let ((next-mark (catch 'found
 557                      (mapcar
 558                       (function
 559                        (lambda (mark)
 560                          (if (< (point) mark)
 561                              (throw 'found mark))))
 562                       tempo-marks)
 563                      ;; return nil if not found
 564                      nil)))
 565     (if next-mark
 566         (goto-char next-mark))))
 567
 568 ;;;
 569 ;;; tempo-backward-mark
 570
 571 (defun tempo-backward-mark ()
 572   "Jump to the previous mark in `tempo-back-mark-list'."
 573   (interactive)
 574   (let ((prev-mark (catch 'found
 575                      (let (last)
 576                        (mapcar
 577                         (function
 578                          (lambda (mark)
 579                            (if (<= (point) mark)
 580                                (throw 'found last))
 581                            (setq last mark)))
 582                         tempo-marks)
 583                        last))))
 584     (if prev-mark
 585         (goto-char prev-mark))))
 586
 587 ;;;
 588 ;;; tempo-add-tag
 589
 590 (defun tempo-add-tag (tag template &optional tag-list)
 591   "Add a template tag.
 592 Add the TAG, that should complete to TEMPLATE to the list in TAG-LIST,
 593 or to `tempo-tags' if TAG-LIST is nil."
 594
 595   (interactive "sTag: \nCTemplate: ")
 596   (if (null tag-list)
 597       (setq tag-list 'tempo-tags))
 598   (if (not (assoc tag (symbol-value tag-list)))
 599       (set tag-list (cons (cons tag template) (symbol-value tag-list))))
 600   (tempo-invalidate-collection))
 601
 602 ;;;
 603 ;;; tempo-use-tag-list
 604
 605 (defun tempo-use-tag-list (tag-list &optional completion-function)
 606   "Install TAG-LIST to be used for template completion in the current buffer.
 607 TAG-LIST is a symbol whose variable value is a tag list created with
 608 `tempo-add-tag'.
 609
 610 COMPLETION-FUNCTION is an obsolete option for specifying an optional
 611 function or string that is used by `\\[tempo-complete-tag]' to find a
 612 string to match the tag against. It has the same definition as the
 613 variable `tempo-match-finder'. In this version, supplying a
 614 COMPLETION-FUNCTION just sets `tempo-match-finder' locally."
 615   (let ((old (assq tag-list tempo-local-tags)))
 616     (if old
 617         (setcdr old completion-function)
 618       (setq tempo-local-tags (cons (cons tag-list completion-function)
 619                                    tempo-local-tags))))
 620   (if completion-function
 621       (setq tempo-match-finder completion-function))
 622   (tempo-invalidate-collection))
 623
 624 ;;;
 625 ;;; tempo-invalidate-collection
 626
 627 (defun tempo-invalidate-collection ()
 628   "Marks the tag collection as obsolete.
 629 Whenever it is needed again it will be rebuilt."
 630   (setq tempo-dirty-collection t))
 631
 632 ;;;
 633 ;;; tempo-build-collection
 634
 635 (defun tempo-build-collection ()
 636   "Build a collection of all the tags and return it.
 637 If `tempo-dirty-collection' is NIL, the old collection is reused."
 638   (prog1
 639       (or (and (not tempo-dirty-collection)
 640                tempo-collection)
 641           (setq tempo-collection
 642                 (apply (function append)
 643                        (mapcar (function (lambda (tag-list)
 644                                         ; If the format for
 645                                         ; tempo-local-tags changes,
 646                                         ; change this
 647                                            (eval (car tag-list))))
 648                                tempo-local-tags))))
 649     (setq tempo-dirty-collection nil)))
 650
 651 ;;;
 652 ;;; tempo-find-match-string
 653
 654 (defun tempo-find-match-string (finder)
 655   "Find a string to be matched against a tag list.
 656 FINDER is a function or a string. Returns (STRING . POS), or nil
 657 if no reasonable string is found."
 658   (cond ((stringp finder)
 659          (let (successful)
 660            (save-excursion
 661              (or (setq successful (re-search-backward finder nil t))
 662                  0))
 663            (if successful
 664                (cons (buffer-substring (match-beginning 1)
 665                                        (match-end 1)) ; This seems to be a
 666                                         ; bug in emacs
 667                      (match-beginning 1))
 668              nil)))
 669         (t
 670          (funcall finder))))
 671
 672 ;;;
 673 ;;; tempo-complete-tag
 674
 675 (defun tempo-complete-tag (&optional silent)
 676   "Look for a tag and expand it.
 677 All the tags in the tag lists in `tempo-local-tags'
 678 \(this includes `tempo-tags') are searched for a match for the text
 679 before the point.  The way the string to match for is determined can
 680 be altered with the variable `tempo-match-finder'. If
 681 `tempo-match-finder' returns nil, then the results are the same as
 682 no match at all.
 683
 684 If a single match is found, the corresponding template is expanded in
 685 place of the matching string.
 686
 687 If a partial completion or no match at all is found, and SILENT is
 688 non-NIL, the function will give a signal.
 689
 690 If a partial completion is found and `tempo-show-completion-buffer' is
 691 non-NIL, a buffer containing possible completions is displayed."
 692
 693   ;; This function may look like a hack, but this is how I want it to
 694   ;; work.
 695   (interactive "*")
 696   (let* ((collection (tempo-build-collection))
 697          (match-info (tempo-find-match-string tempo-match-finder))
 698          (match-string (car match-info))
 699          (match-start (cdr match-info))
 700          (exact (assoc match-string collection))
 701          (compl (or (car exact)
 702                     (and match-info (try-completion match-string collection)))))
 703     (if compl (delete-region match-start (point)))
 704     (cond ((null match-info) (or silent (ding)))
 705           ((null compl) (or silent (ding)))
 706           ((eq compl t) (tempo-insert-template
 707                          (cdr (assoc match-string
 708                                      collection))
 709                          nil))
 710           (t (if (setq exact (assoc compl collection))
 711                  (tempo-insert-template (cdr exact) nil)
 712                (insert compl)
 713                (or silent (ding))
 714                (if tempo-show-completion-buffer
 715                    (tempo-display-completions match-string
 716                                               collection)))))))
 717
 718
 719 ;;;
 720 ;;; tempo-display-completions
 721
 722 (defun tempo-display-completions (string tag-list)
 723   "Show a buffer containing possible completions for STRING."
 724   (if tempo-leave-completion-buffer
 725       (with-output-to-temp-buffer "*Completions*"
 726         (display-completion-list
 727          (all-completions string tag-list)))
 728     (save-window-excursion
 729       (with-output-to-temp-buffer "*Completions*"
 730         (display-completion-list
 731          (all-completions string tag-list)))
 732       (sit-for 32767))))
 733
 734 ;;;
 735 ;;; tempo-expand-if-complete
 736
 737 (defun tempo-expand-if-complete ()
 738   "Expand the tag before point if it is complete.
 739 Returns non-nil if an expansion was made and nil otherwise.
 740
 741 This could as an example be used in a command that is bound to the
 742 space bar, and looks something like this:
 743
 744 (defun tempo-space ()
 745   (interactive \"*\")
 746   (or (tempo-expand-if-complete)
 747       (insert \" \")))"
 748
 749   (interactive "*")
 750   (let* ((collection (tempo-build-collection))
 751          (match-info (tempo-find-match-string tempo-match-finder))
 752          (match-string (car match-info))
 753          (match-start (cdr match-info))
 754          (exact (assoc match-string collection)))
 755     (if exact
 756         (progn
 757           (delete-region match-start (point))
 758           (tempo-insert-template (cdr exact) nil)
 759           t)
 760       nil)))
 761
 762 (provide 'tempo)
 763
 764 ;;; tempo.el ends here