emacs/lisp/tempo.el

;;; tempo.el --- templates with hotspots
;; Copyright (C) 1994 Free Software Foundation, Inc.

;; Author: David K}gedal <davidk@lysator.liu.se >
;; Created: 16 Feb 1994
;; Version: 1.1.1
;; Keywords: extensions, languages, tools

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Commentary:

;; This file provides a simple way to define powerful templates, or
;; macros, if you wish. It is mainly intended for, but not limited to,
;; other programmers to be used for creating shortcuts for editing
;; certain kind of documents. It was originally written to be used by
;; a HTML editing mode written by Nelson Minar <nelson@reed.edu>, and
;; his html-helper-mode.el is probably the best example of how to use
;; this program.

;; A template is defined as a list of items to be inserted in the
;; current buffer at point. Some of the items can be simple strings,
;; while other can control formatting or define special points of
;; interest in the inserted text.

;; If a template defines a "point of interest" that point is inserted
;; in a buffer-local list of "points of interest" that the user can
;; jump between with the commands `tempo-backward-mark' and
;; `tempo-forward-mark'. If the template definer provides a prompt for
;; the point, and the variable `tempo-interactive' is non-nil, the
;; user will be prompted for a string to be inserted in the buffer,
;; using the minibuffer.

;; The template can also define one point to be replaced with the
;; current region if the template command is called with a prefix (or
;; a non-nil argument).

;; More flexible templates can be created by including lisp symbols,
;; which will be evaluated as variables, or lists, which will will be
;; evaluated as lisp expressions.

;; See the documentation for tempo-define-template for the different
;; items that can be used to define a tempo template.

;; One of the more powerful features of tempo templates are automatic
;; completion. With every template can be assigned a special tag that
;; should be recognized by `tempo-complete-tag' and expanded to the
;; complete template. By default the tags are added to a global list
;; of template tags, and are matched against the last word before
;; point. But if you assign your tags to a specific list, you can also
;; specify another method for matching text in the buffer against the
;; tags. In the HTML mode, for instance, the tags are matched against
;; the text between the last `<' and point.

;; When defining a template named `foo', a symbol named
;; `tempo-template-foo' will be created whose value as a variable will
;; be the template definition, and its function value will be an
;; interactive function that inserts the template at the point.

;; Full documentation for tempo.el can be found on the World Wide Web
;; at http://www.lysator.liu.se:7500/~davidk/tempo.html (not yet
;; completed)

;; The latest tempo.el distribution can be fetched from
;; ftp.lysator.liu.se in the directory /pub/emacs

;;; Code:

(provide 'tempo)

;;; Variables

(defvar tempo-interactive nil
  "*Prompt user for strings in templates.
If this variable is non-nil, `tempo-insert' prompts the
user for text to insert in the templates")

(defvar tempo-insert-region nil
  "*Automatically insert current region when there is a `r' in the template
If this variable is NIL, `r' elements will be treated just like `p'
elements, unless the template function is given a prefix (or a non-nil
argument). If this variable is non-NIL, the behaviour is reversed.")

(defvar tempo-show-completion-buffer t
  "*If non-NIL, show a buffer with possible completions, when only
a partial completion can be found")

(defvar tempo-leave-completion-buffer nil
  "*If NIL, a completion buffer generated by \\[tempo-complete-tag]
disappears at the next keypress; otherwise, it remains forever.")

(defvar tempo-insert-string-functions nil
  "List of functions to run when inserting a string.
Each function is called with a single arg, STRING."  )

(defvar tempo-tags nil
  "An association list with tags and corresponding templates")

(defvar tempo-local-tags '((tempo-tags . nil))
  "A list of locally installed tag completion lists.

It is a association list where the car of every element is a symbol
whose varable value is a template list. The cdr part, if non-nil, is a
function or a regexp that defines the string to match. See the
documentation for the function `tempo-complete-tag' for more info.

`tempo-tags' is always in the last position in this list.")

(defvar tempo-marks nil
  "A list of marks to jump to with `\\[tempo-forward-mark]' and `\\[tempo-backward-mark]'.")

(defvar tempo-default-match-finder "\\b\\([^\\b]*\\)\\="
  "The default regexp used to find the string to match against the tags.")

(defvar tempo-named-insertions nil
  "Temporary storage for named insertions")

;; Make some variables local to every buffer

(make-variable-buffer-local 'tempo-marks)
(make-variable-buffer-local 'tempo-local-tags)

;;; Functions

;;
;; tempo-define-template

(defun tempo-define-template (name elements &optional tag documentation taglist)
  "Define a template.
This function creates a template variable `tempo-template-NAME' and an
interactive function `tempo-template-NAME' that inserts the template
at the point.  The created function is returned.

NAME is a string that contains the name of the template, ELEMENTS is a
list of elements in the template, TAG is the tag used for completion,
DOCUMENTATION is the documentation string for the insertion command
created, and TAGLIST (a symbol) is the tag list that TAG (if provided)
should be added to).  If TAGLIST is nil and TAG is non-nil, TAG is
added to `tempo-tags'

The elements in ELEMENTS can be of several types:

 - A string. It is sent to the hooks in `tempo-insert-string-functions',
   and the result is inserted.
 - The symbol 'p. This position is saved in `tempo-marks'.
 - The symbol 'r. If `tempo-insert' is called with ON-REGION non-nil
   the current region is placed here. Otherwise it works like 'p.
 - (p PROMPT <NAME>) If `tempo-interactive' is non-nil, the user is
   prompted in the minbuffer with PROMPT for a string to be inserted.
   If the optional parameter NAME is non-nil, the text is saved for
   later insertion with the `s' tag.
   If `tempo-interactive is nil, it works like 'p.
 - (r PROMPT) like the previous, but if `tempo-interactive' is nil
   and `tempo-insert' is called with ON-REGION non-nil, the current
   region is placed here.
 - (s NAME) Inserts text previously read with the (p ..) construct.
   Finds the insertion saved under NAME and inserts it. Acts like 'p
   if tempo-interactive is nil.
 - '& If there is only whitespace between the line start and point,
   nothing happens. Otherwise a newline is inserted.
 - '% If there is only whitespace between point and end-of-line
   nothing happens. Otherwise a newline is inserted.
 - 'n inserts a newline.
 - '> The line is indented using `indent-according-to-mode'. Note that
   you often should place this item after the text you want on the
   line.
 - 'n> inserts a newline and indents line.
 - nil. It is ignored.
 - Anything else. It is evaluated and the result is parsed again."

  (let* ((template-name (intern (concat "tempo-template-"
				       name)))
	 (command-name template-name))
    (set template-name elements)
    (fset command-name (list 'lambda (list '&optional 'arg)
			     (or documentation 
				 (concat "Insert a " name "."))
			     (list 'interactive "*P")
			     (list 'tempo-insert-template (list 'quote
								template-name)
				   (list 'if 'tempo-insert-region
					 (list 'not 'arg) 'arg))))
    (and tag
	 (tempo-add-tag tag template-name taglist))
    command-name))

;;;
;;; tempo-insert-template

(defun tempo-insert-template (template on-region)
  "Insert a template.
TEMPLATE is the template to be inserted.  If ON-REGION is non-nil the
`r' elements are replaced with the current region."
  (and on-region
       (< (mark) (point))
       (exchange-point-and-mark))
  (save-excursion
    (tempo-insert-mark (point-marker))
    (mapcar 'tempo-insert 
	    (symbol-value template))
    (tempo-insert-mark (point-marker)))
  (tempo-forward-mark)
  (tempo-forget-insertions))

;;;
;;; tempo-insert

(defun tempo-insert (element) 
  "Insert a template element.
Insert one element from a template. See documentation for
`tempo-define-template' for the kind of elements possible."
  (cond ((stringp element) (tempo-process-and-insert-string element))
	((and (consp element) (eq (car element) 'p))
	 (tempo-insert-prompt (cdr element)))
	((and (consp element) (eq (car element) 'r))
	 (if on-region
	     (exchange-point-and-mark)
	   (tempo-insert-prompt (cdr element))))
	((and (consp element) (eq (car element) 's))
	 (if tempo-interactive
	     (tempo-insert-named (cdr element))
	   (tempo-insert-mark (point-marker))))
	((eq element 'p) (tempo-insert-mark (point-marker)))
	((eq element 'r) (if on-region
			     (exchange-point-and-mark)
			   (tempo-insert-mark (point-marker))))
	((eq element '>) (indent-according-to-mode))
	((eq element '&) (if (not (or (= (current-column) 0)
				      (save-excursion
					(re-search-backward
					 "^\\s-*\\=" nil t))))
			     (insert "\n")))
	((eq element '%) (if (not (or (eolp)
				      (save-excursion
					(re-search-forward
					 "\\=\\s-*$" nil t))))
			     (insert "\n")))
	((eq element 'n) (insert "\n"))
	((eq element 'n>) (insert "\n") (indent-according-to-mode))
	((null element))
	(t (tempo-insert (eval element)))))

;;;
;;; tempo-insert-prompt

(defun tempo-insert-prompt (prompt)
  "Prompt for a text string and insert it in the current buffer.
If the variable `tempo-interactive' is non-nil the user is prompted
for a string in the minibuffer, which is then inserted in the current
buffer. If `tempo-interactive' is nil, the current point is placed on
`tempo-mark'.

PROMPT is the prompt string or a list containing the prompt string and
a name to save the inserted text under."
  (if tempo-interactive
      (let ((prompt-string (if (listp prompt)
			       (car prompt)
			     prompt))
	    (save-name (and (listp prompt) (nth 1 prompt)))
	    inserted-text)

	(progn
	  (setq inserted-text (read-string prompt-string))
	  (insert inserted-text)
	  (if save-name
	      (tempo-remember-insertion save-name inserted-text))))
    (tempo-insert-mark (point-marker))))

;;;
;;; tempo-remember-insertion

(defun tempo-remember-insertion (save-name string)
  "Save the text in STRING under the name SAVE-NAME for later retrieval."
  (setq tempo-named-insertions (cons (cons save-name string)
				     tempo-named-insertions)))

;;;
;;; tempo-forget-insertions

(defun tempo-forget-insertions ()
  "Forget all the saved named insertions."
  (setq tempo-named-insertions nil))

;;;
;;; tempo-insert-named

(defun tempo-insert-named (elt)
  "Insert the previous insertion saved under a named specified in ELT.
The name is in the car of ELT."
  (let* ((name (car elt))
	 (insertion (cdr (assq name tempo-named-insertions))))
    (if insertion
	(insert insertion)
      (error "Named insertion not found"))))

;;;
;;; tempo-process-and-insert-string

(defun tempo-process-and-insert-string (string)
  "Insert a string from a template.
Run a string through the preprocessors in `tempo-insert-string-functions'
and insert the results."
  (cond ((null tempo-insert-string-functions)
	 nil)
	((symbolp tempo-insert-string-functions)
	 (setq string
	       (apply tempo-insert-string-functions (list string))))
	((listp tempo-insert-string-functions)
	 (mapcar (function (lambda (fn)
			     (setq string (apply fn string))))
		 tempo-insert-string-functions))
	(t
	 (error "Bogus value in tempo-insert-string-functions: %s"
		tempo-insert-string-functions)))
  (insert string))

;;;
;;; tempo-insert-mark

(defun tempo-insert-mark (mark)
  "Insert a mark `tempo-marks' while keeping it sorted"
  (cond ((null tempo-marks) (setq tempo-marks (list mark)))
	((< mark (car tempo-marks)) (setq tempo-marks (cons mark tempo-marks)))
	(t (let ((lp tempo-marks))
	     (while (and (cdr lp)
			 (<= (car (cdr lp)) mark))
	       (setq lp (cdr lp)))
	     (if (not (= mark (car lp)))
		 (setcdr lp (cons mark (cdr lp))))))))
	  
;;;
;;; tempo-forward-mark

(defun tempo-forward-mark ()
  "Jump to the next mark in `tempo-forward-mark-list'."
  (interactive)
  (let ((next-mark (catch 'found
		     (mapcar
		      (function
		       (lambda (mark)
			 (if (< (point) mark)
			     (throw 'found mark))))
		      tempo-marks)
		     ;; return nil if not found
		     nil)))
    (if next-mark
	(goto-char next-mark))))

;;;
;;; tempo-backward-mark

(defun tempo-backward-mark ()
  "Jump to the previous mark in `tempo-back-mark-list'."
  (interactive)
  (let ((prev-mark (catch 'found
		     (let (last)
		       (mapcar
			(function
			 (lambda (mark)
			   (if (<= (point) mark)
			       (throw 'found last))
			   (setq last mark)))
			tempo-marks)
		       last))))
    (if prev-mark
	(goto-char prev-mark))))
	
;;;
;;; tempo-add-tag

(defun tempo-add-tag (tag template &optional tag-list)
  "Add a template tag.

Add the TAG, that should complete to TEMPLATE to the list in TAG-LIST,
or to `tempo-tags' if TAG-LIST is nil."

  (interactive "sTag: \nCTemplate: ")
  (if (null tag-list)
      (setq tag-list 'tempo-tags))
  (if (not (assoc tag (symbol-value tag-list)))
      (set tag-list (cons (cons tag template) (symbol-value tag-list)))))

;;;
;;; tempo-use-tag-list

(defun tempo-use-tag-list (tag-list &optional completion-function)
  "Install TAG-LIST to be used for template completion in the current buffer.

TAG-LIST is a symbol whose variable value is a tag list created with
`tempo-add-tag' and COMPLETION-FUNCTION is an optional function or
string that is used by `\\[tempo-complete-tag]' to find a string to
match the tag against.

If COMPLETION-FUNCTION is a string, it should contain a regular
expression with at least one \\( \\) pair. When searching for tags,
`tempo-complete-tag' calls `re-search-backward' with this string, and
the string between the first \\( and \\) is used for matching against
each string in the tag list. If one is found, the whole text between
the first \\( and the point is replaced with the inserted template.

You will probably want to include \\ \= at the end of the regexp to make
sure that the string is matched only against text adjacent to the
point.

If COPMLETION-FUNCTION is a symbol, it should be a function that
returns a cons cell of the form (STRING . POS), where STRING is the
string used for matching and POS is the buffer position after which
text should be replaced with a template."

  (let ((old (assq tag-list tempo-local-tags)))
    (if old
	(setcdr old completion-function)
      (setq tempo-local-tags (cons (cons tag-list completion-function)
				   tempo-local-tags)))))

;;;
;;; tempo-find-match-string

(defun tempo-find-match-string (finder)
  "Find a string to be matched against a tag list.

FINDER is a function or a string. Returns (STRING . POS)."
  (cond ((stringp finder)
	 (save-excursion
	   (re-search-backward finder nil t))
	 (cons (buffer-substring (match-beginning 1) (1+ (match-end 1)))
	       (match-beginning 1)))
	(t
	 (funcall finder))))

;;;
;;; tempo-complete-tag

(defun tempo-complete-tag (&optional silent)
  "Look for a tag and expand it.

It goes through the tag lists in `tempo-local-tags' (this includes
`tempo-tags') and for each list it uses the corresponding match-finder
function, or `tempo-default-match-finder' if none is given, and tries
to match the match string against the tags in the list using
`try-completion'. If none is found it proceeds to the next list until
one is found. If a partial completion is found, it is replaced by the
template if it can be completed uniquely, or completed as far as
possible.

When doing partial completion, only tags in the currently examined
list are considered, so if you provide similar tags in different lists
in `tempo-local-tags', the result may not be desirable.

If no match is found or a partial match is found, and SILENT is
non-nil, the function will give a signal.

If tempo-show-completion-buffer is non-NIL, a buffer containing
possible completions is displayed when a partial completion is found."

  ;; This function is really messy. Some cleaning up is necessary.
  (interactive)
  (if (catch 'completed
	(mapcar
	 (function
	  (lambda (tag-list-a)
	    (let* ((tag-list (symbol-value(car tag-list-a)))
		   (match-string-finder (or (cdr tag-list-a)
					    tempo-default-match-finder))
		   (match-info (tempo-find-match-string match-string-finder))
		   (match-string (car match-info))
		   (match-start (cdr match-info))
		   (compl (or (cdr (assoc match-string tag-list))
			      (try-completion match-string
					      tag-list))))
	
	      (if compl			;any match
		  (delete-region match-start (point)))

	      (cond
	       ((null compl)		; No match
		nil)
	       ((symbolp compl)		; ??
		(tempo-insert-template compl nil)
		(throw 'completed t))
	       ((eq compl t)		; Exact, sole match
		(tempo-insert-template (cdr (assoc match-string tag-list))
				       nil)
		(throw 'completed t))
	       ((stringp compl)		; (partial) completion found
		(let ((compl2 (assoc compl tag-list)))
		  (if compl2
		      (tempo-insert-template (cdr compl2) nil)
		    (insert compl)
		    (if t ;(string= match-string compl)
			(if tempo-show-completion-buffer
			    (tempo-display-completions match-string
						       tag-list)
			  (if (not silent)
			      (ding))))))
		(throw 'completed t))))))
	 tempo-local-tags)
	;; No completion found. Return nil
	nil)
      ;; Do nothing if a completion was found
      t
    ;; No completion was found
    (if (not silent)
	(ding))
    nil))

;;;
;;; tempo-display-completions

(defun tempo-display-completions (string tag-list)
  "Show a buffer containing possible completions for STRING."
  (if tempo-leave-completion-buffer
      (with-output-to-temp-buffer "*Completions*"
	(display-completion-list
	 (all-completions string tag-list)))
    (save-window-excursion
      (with-output-to-temp-buffer "*Completions*"
	(display-completion-list
	 (all-completions string tag-list)))
      (sit-for 32767))))

;;; tempo.el ends here