Usenet 1994 January/usenetsourcesnewsgroupsinfomagicjanuary1994.iso/sources/unix/volume11/templates/part03/tplhelper.el

Text File | 1987-10-04 | 44.0 KB | 1,481 lines

;;; tplhelper.el -- Helper functions for template-mode.
;;; Copyright (C) 1987 Mark A. Ardis.

(provide 'tplhelper)

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-blank-line ()
  "Returns t if current line contains only whitespace.
    Otherwise, returns nil."
                    ; Local Variables
  (let (result)
                    ; Body
    (save-excursion
      (beginning-of-line)
      (if (eolp)
      (setq result t)
    ; else
    (progn
      (re-search-forward tpl-pattern-whitespace (point-max) t)
      (if (eolp)
          (setq result t)
        (setq result nil)
        ) ; if
      ) ; progn
    ) ; if
      ) ; save
    ; return
    result
    ) ; let
  ) ; defun tpl-blank-line

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-build-template-list ()
  "Build template-list, using current major mode."
                    ; Local Variables
  (let (mode-entry template-list)
                    ; Body
    (setq tpl-local-template-list
      (list (tpl-mode-templates
         (tpl-mode-match 'generic tpl-global-template-list))))
    ; Use loaded templates if available
    (setq template-list
      (tpl-mode-templates
       (tpl-mode-match major-mode tpl-global-template-list)))
    (if template-list
    (setq tpl-local-template-list
          (cons template-list tpl-local-template-list))
      ; else
      (progn
    (setq mode-entry (tpl-mode-match major-mode tpl-auto-template-alist))
    (if mode-entry
        (progn
          (load-tpl-library (tpl-mode-file mode-entry) major-mode)
          ) ; progn
      ; else
      (message "No templates found for this mode.")
      ) ; if mode-entry
    ) ; progn
      ) ; if template-list
    (if tpl-rebuild-all-templates-template
    (tpl-make-all-templates-template)
      ) ; if
    ) ; let
  ) ; defun tpl-build-template-list

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-delete-placeholders-in-region (start stop)
  "Delete all placeholders in region between START and STOP."
                    ; Local Variables
  (let (stop-marker)
                    ; Body
    (setq stop-marker (make-marker))
    (set-marker stop-marker stop)
    (goto-char start)
    (while (re-search-forward tpl-pattern-placeholder
                  (marker-position stop-marker) t)
      (re-search-backward tpl-pattern-placeholder)
      (delete-placeholder)
      ) ; while
    (set-marker stop-marker nil)
    ) ; let
  ) ; defun tpl-delete-placeholders-in-region

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-expand-lexical-type (name stop)
  "Expand the lexical placeholder NAME at point.  Replaces all instances
    of identical placeholders before STOP with the same value.
    Checks for match with lexical description."
                    ; Local Variables
  (let (save-hook)
                    ; Body
    (if (boundp 'sym-check-validity-hook)
    (setq save-hook sym-check-validity-hook)
      (setq save-hook nil)
      ) ; if
    (setq sym-check-validity-hook 'tpl-lexical-check)
    (setq tpl-lexical-pattern (tpl-find-value-of-template name))
    (if tpl-lexical-pattern
    (tpl-expand-text-type stop)
      (error "Cannot find template.")
      ) ; if
    (setq sym-check-validity-hook save-hook)
    ) ; let
  ) ; defun tpl-expand-lexical-type

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-expand-placeholder (stop)
  "Expand the placeholder at point.  Replace identical occurrences
    of text placeholders before STOP with the same value."
                    ; Local Variables
  (let (placeholder template-name start placeholder-name)
                    ; Body
    (setq start (point))
                    ; Process placeholder
    (setq placeholder (tpl-scan-placeholder))
    (setq template-name (tpl-token-name placeholder))
    (setq placeholder-name (tpl-token-value placeholder))
    (cond
     ((equal template-name "text")
      (tpl-expand-text-type stop)
      ) ; (equal template-name "text")
     ((equal template-name "textenter")
      (tpl-expand-textenter-type stop)
      ) ; (equal template-name "textenter")
     ((equal template-name "textlong")
      (tpl-expand-textlong-type placeholder-name)
      ) ; (equal template-name "textlong")
     ((equal template-name tpl-destination-symbol)
      (progn
    (re-search-forward tpl-pattern-placeholder)
    (ding)
    (message "Cannot expand destination placeholder.")
    ) ; progn
      ) ; (equal template-name "textlong")
     (t
      (if (equal tpl-lexical-type
         (tpl-find-type-of-template template-name))
      (tpl-expand-lexical-type template-name stop)
    ; else
    (progn
      (re-search-forward tpl-pattern-placeholder)
      (delete-region start (point))
      (tpl-insert-template template-name)
      ) ; progn
    ) ; if
      ) ; t
     ) ; cond
    ) ; let
  ) ; defun tpl-expand-placeholder

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-expand-text-type (stop)
  "Expand the text placeholder at point.  Replace identical placeholders
    before STOP with the same value.  Return that value."
                    ; Local Variables
  (let (start stop-marker placeholder-string sym-input)
                    ; Body
    (setq start (point))
    (if stop
    (progn
      (setq stop-marker (make-marker))
      (set-marker stop-marker stop)
      ) ; progn
      ) ; if stop
    (re-search-forward tpl-pattern-placeholder)
    (setq placeholder-string (buffer-substring start (point)))
    (goto-char start)
    (setq sym-input (sym-read-string
             (concat "Replace " placeholder-string " with what? ")
             placeholder-string))
    (if (= (length sym-input) 0)
    (re-search-forward placeholder-string)
      ; else
      (if stop
      (progn
        (setq start (point))
                    ; Replace all identical placeholders
        (while (re-search-forward placeholder-string
                      (marker-position stop-marker) t)
          (re-search-backward placeholder-string)
          (insert-before-markers sym-input)
          (delete-char (length placeholder-string))
          ) ; while (re-search-forward...)
        (goto-char start)
        ) ; progn
    ) ; if stop
      ) ; if (= (length sym-input) 0)
    ; return
    sym-input
    ) ; let
  ) ; defun tpl-expand-text-type

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-expand-textenter-type (stop)
  "Expand the text placeholder at point.  Replace identical placeholders
    before STOP with the same value.  Enter that value in the symbol
    table."
                    ; Local Variables
  (let (value)
                    ; Body
    (setq value (tpl-expand-text-type stop))
    (sym-enter-id value)
    ) ; let
  ) ; defun tpl-expand-textenter-type


;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-expand-textlong-type (name)
  "Expand the textlong placeholder at point called NAME."
                    ; Local Variables
  (let (start display-string save-buffer new-string start-column)
                    ; Body
                    ; Highlight placeholder
    (setq start (point))
    (re-search-forward tpl-pattern-placeholder)
    (delete-region start (point))
    (setq display-string (concat tpl-display-begin name tpl-display-end))
    (insert-before-markers display-string)
    (backward-char (length display-string))
                    ; Save current location
    (setq start (point))
                    ; Prepare buffer
    (save-window-excursion
      (setq save-buffer (buffer-name))
      (switch-to-buffer-other-window tpl-textlong-buffer)
      (erase-buffer)
      (shrink-window 5)
                    ; Wait for return from recursive edit
      (message (substitute-command-keys
        "Type replacement and exit with \\[exit-recursive-edit]"))
      (recursive-edit)
                    ; Get new value and insert
      (setq new-string (buffer-substring (point-min) (point-max)))
      (set-buffer save-buffer)
      (delete-windows-on tpl-textlong-buffer)
      ) ; save-window-excursion
    (bury-buffer tpl-textlong-buffer)
                    ; Return to proper location
    (goto-char start)
    (delete-char (length display-string))
    (setq start-column (current-column))
    (setq start (point))
    (insert-before-markers new-string)
    (indent-rigidly start (point) start-column)
    ) ; let
  ) ; defun tpl-expand-textlong-type

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-find-end-of-group ()
  "Find the end of a group defined for query-replace-groups."
                    ; Local Variables
  (let ()
                    ; Body
    (if tpl-form-placeholder-name-from-context
    (tpl-make-placeholder-name)
      ) ; if tpl-form-placeholder-name-from-context
    (if tpl-include-prefix-in-groups
    (beginning-of-line nil)
      ) ; if tpl-include-prefix-in-groups
    (set-mark (point))
    (end-of-line nil)
    (re-search-forward tpl-end-group nil "not-t")
    (if tpl-verify-end-of-group
    (progn
      (message
       (concat "Position point AFTER end of group and exit ("
           (substitute-command-keys "\\[exit-recursive-edit]")
           ")."))
      (unwind-protect
          (recursive-edit)
        ) ; unwind-protect
      ) ; progn
      ) ; if tpl-verify-end-of-group
    (end-of-line 0)
    ) ; let
  ) ; defun tpl-find-end-of-group

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-find-expansion-destination (start stop)
  "Delete special destination placeholder between START and STOP
    and set destination marker if a destination needs to be found."
                    ; Local Variables
  (let (stop-marker)
                    ; Body
    (goto-char start)
    (setq stop-marker (make-marker))
    (set-marker stop-marker stop)
    (while (re-search-forward tpl-destination-placeholder stop stop)
    (progn
      (re-search-backward tpl-pattern-placeholder)
      (delete-placeholder)
      (if tpl-destination-needed
          (progn
        (set-marker tpl-destination-marker (point))
        (setq tpl-destination-needed nil)
        ) ; progn
        ) ; if tpl-destination-needed
      ) ; progn
      ) ; while (re-search-forward tpl-destination-placeholder stop stop)
    (goto-char (marker-position stop-marker))
    (set-marker stop-marker nil)
    ) ; let
  ) ; defun tpl-find-expansion-destination

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-find-next-group ()
  "Find the end of a group defined for query-replace-groups.
    Do not interact with user."
                    ; Local Variables
  (let ()
                    ; Body
    (end-of-line nil)
    (re-search-forward tpl-end-group nil "not-t")
    (end-of-line 0)
    ) ; let
  ) ; defun tpl-find-next-group

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-find-template-file (file)
  "Find FILE using the 'tpl-load-path value."
                    ; Local Variables
  (let (tpl-name compiled-name dir-list looking)
                    ; Body
    (setq tpl-name (concat file ".tpl"))
    (setq compiled-name (concat file "tpl.elc"))
    (setq name nil)
    (setq looking t)
                    ; First try compiled versions
    (setq dir-list tpl-load-path)
    (while (and looking dir-list)
      (setq name (concat (car dir-list) "/" compiled-name))
      (setq dir-list (cdr dir-list))
      (if (file-readable-p name)
      (setq looking nil)
    ) ; if
      ) ; while
                    ; Second, try uncompiled
    (setq dir-list tpl-load-path)
    (while (and looking dir-list)
      (setq name (concat (car dir-list) "/" tpl-name))
      (setq dir-list (cdr dir-list))
      (if (file-readable-p name)
      (setq looking nil)
    ) ; if
      ) ; while
                    ; Last, try literal name
    (setq dir-list tpl-load-path)
    (while (and looking dir-list)
      (setq name (concat (car dir-list) "/" file))
      (setq dir-list (cdr dir-list))
      (if (file-readable-p name)
      (setq looking nil)
    ) ; if
      ) ; while
    ; return
    name
    ) ; let
  ) ; defun tpl-find-template-file

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-find-template (tpl-name)
  "Find template TPL_NAME and return template or nil (if not found)."
                    ; Local Variables
  (let (found file-list template-file template-list template template-name)
                    ; Body
    (setq found nil)
    (setq file-list tpl-local-template-list)
    (while (and file-list (not found))
      (setq template-file (car file-list))
      (setq file-list (cdr file-list))
      (setq template-list (nth 1 template-file))
      (while (and template-list (not found))
    (setq template (car template-list))
    (setq template-list (cdr template-list))
    (setq template-name (tpl-token-name template))
    (if (equal template-name tpl-name)
        (setq found template)
      ) ; if (equal template-name tpl-name)
    ) ; while (and template-list (not found))
      ) ; while (and file-list (not found))
                    ; return
    found
    ) ; let
  ) ; defun tpl-find-template

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-find-type-of-template (name)
  "Find template NAME and return its type or nil (if not found)."
                    ; Local Variables
  (let (template result)
                    ; Body
    (setq template (tpl-find-template name))
    (if template
    (setq result (tpl-token-type template))
      (setq result nil)
      ) ; if
                    ; return
    result
    ) ; let
  ) ; defun tpl-find-type-of-template

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-find-value-of-template (name)
  "Find template NAME and return its value or nil (if not found)."
                    ; Local Variables
  (let (template result)
                    ; Body
    (setq template (tpl-find-template name))
    (if template
    (setq result (tpl-token-value template))
      (setq result nil)
      ) ; if
                    ; return
    result
    ) ; let
  ) ; defun tpl-find-value-of-template

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-find-wrappers (tpl-name)
  "Find the beginning and ending part of TPL-NAME that encloses a
    destination placeholder."
                    ; Local Variables
  (let (msg template midpoint result)
                    ; Body
    (setq msg nil)
    (setq template (tpl-find-template tpl-name))
    (save-excursion
      (set-buffer tpl-work-buffer)
      (erase-buffer)
      (if template
      (progn
        (tpl-unscan template)
        (goto-char (point-min))
        (if (re-search-forward tpl-destination-placeholder
                   (point-max) t)
        (progn
          (delete-region (match-beginning 0) (match-end 0))
          (setq midpoint (point))
          ) ; progn
          ; else
          (progn
        (setq msg "Template does not contain a destination placeholder.")
        ) ; progn
          ) ; if
        ) ; progn
    ; else
    (progn
      (setq msg "Cannot find template.")
      ) ; progn
    ) ; if template
      (if (not msg)
      (setq result (list (buffer-substring 1 midpoint)
                 (buffer-substring midpoint (point-max))
                 (current-column)))
    ) ; if
      ) ; save-excursion
    (bury-buffer tpl-work-buffer)
    (if msg
    (error msg)
      ) ; if
                    ; return
    result
    ) ; let
  ) ; defun tpl-find-wrappers

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-generate (tpl-name)
  "Insert and expand the template TPL-NAME at point."
                    ; Local Variables
  (let (start stop)
                    ; Body
    ; Insert and expand template
    (setq start (point))
    (insert-before-markers tpl-begin-placeholder tpl-name tpl-end-placeholder)
    (goto-char start)
    (setq tpl-destination-needed t)
    (message "Looking for template...")
    (tpl-expand-placeholder nil)
    (setq stop (point))
    (if (not tpl-destination-needed)
    (progn
      (goto-char (marker-position tpl-destination-marker))
      (set-marker tpl-destination-marker nil)
      ) ; progn
      ; else
      (progn
    (setq tpl-destination-needed nil)
    (goto-char start)
    (if (re-search-forward tpl-pattern-placeholder stop stop)
        (re-search-backward tpl-pattern-placeholder)
      ) ; if
    ) ; progn
      ) ; if (not tpl-destination-needed)
    (message "%s" "Done.")
    ) ; let
  ) ; defun tpl-generate

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-get-placeholder-name ()
  "Prompt for a placeholder name.  If none supplied, use temporary
    name and regenerate another unique name.  Return the name."
                    ; Local Variables
  (let (name)
                    ; Body
    (if tpl-query-flag
    (progn
      (setq name (read-string
              (concat "Template name? ("
                  tpl-next-placeholder-name ") ")))
      ) ; progn
      ; else
      (setq name "")
      ) ; if tpl-query-flag
    (if (equal name "")
    (progn
      (setq name tpl-next-placeholder-name)
      (tpl-increment-next-placeholder-name)
      ) ; progn
      ) ; if (equal name "")
                    ; return
    name
    ) ; let
  ) ; tpl-get-placeholder-name

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-increment-next-placeholder-name ()
  "Increment unique name for temporary placeholders."
                    ; Local Variables
  (let ()
                    ; Body
    (setq tpl-next-placeholder-number
      (1+ tpl-next-placeholder-number))
    (setq tpl-next-placeholder-name
      (concat tpl-temporary-placeholder-name
          tpl-next-placeholder-number))
    ) ; let
  ) ; defun tpl-increment-next-placeholder-name

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-initialize-modes ()
  "Create initial Alist of major modes and their associated template files.
    Calls 'template-mode-load-hook' if it is defined."
                    ; Local Variables
  (let ()
                    ; Body
    (or (assq 'template-mode minor-mode-alist)
    (setq minor-mode-alist
          (cons '(template-mode " Template") minor-mode-alist)))
    (setq tpl-auto-template-alist
      (list
       (tpl-make-mode-entry 'awk-mode "awk")
       (tpl-make-mode-entry 'bib-mode "bib")
       (tpl-make-mode-entry 'c-mode "c")
       (tpl-make-mode-entry 'emacs-lisp-mode "elisp")
       (tpl-make-mode-entry 'generic "generic")
       (tpl-make-mode-entry 'LaTeX-mode "latex")
                    ; Should have another set of templates
                    ;   for Lisp
       (tpl-make-mode-entry 'lisp-mode "elisp")
       (tpl-make-mode-entry 'pascal-mode "pascal")
       (tpl-make-mode-entry 'scribe-mode "scribe")
       (tpl-make-mode-entry 'texinfo-mode "texinfo")
                    ; Should have another set of templates
                    ;    for TeX
       (tpl-make-mode-entry 'plain-TeX-mode "latex")
        ))
    (setq tpl-local-template-list nil)
    (get-buffer-create tpl-menu-buffer)
    (get-buffer-create tpl-textlong-buffer)
    (get-buffer-create tpl-work-buffer)
    (bury-buffer tpl-menu-buffer)
    (bury-buffer tpl-textlong-buffer)
    (bury-buffer tpl-work-buffer)
    (tpl-initialize-scan)
    (load-tpl-library "generic" 'generic)
    (and (boundp 'template-mode-load-hook)
     template-mode-load-hook
     (funcall template-mode-load-hook))
    ) ; let
  ) ; defun tpl-initialize-modes

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-insert-function (template)
  "Insert a template at point using the function type TEMPLATE."
                    ; Local Variables
  (let (start stop-marker result save-depth)
                    ; Body
    (setq start (point))
    (setq stop-marker (make-marker))
    (insert (tpl-token-value template))
    (set-marker stop-marker (point))
                    ; Temporarily expand placeholders
                    ;    without asking
    (setq save-depth tpl-ask-expansion-depth)
    (setq tpl-ask-expansion-depth 10)
    (expand-placeholders-in-region start (point))
    (setq tpl-ask-expansion-depth save-depth)
                    ; Evaluate result
    (goto-char start)
    (save-excursion
      (setq result (eval (read (current-buffer))))
      ) ; save-excursion
                    ; Remove placeholder and insert result
    (delete-region start (marker-position stop-marker))
    (set-marker stop-marker nil)
    (insert result)
    ) ; let
  ) ; defun tpl-insert-function

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-insert-repetition (template)
  "Insert at point instances of the repetition type TEMPLATE."
                    ; Local Variables
  (let (start template-name column)
                    ; Body
    (setq start (point))
    (setq column (current-column))
    (setq template-name (tpl-token-name template))
                    ; Insert first instance
    (tpl-unscan template)
    (re-search-backward tpl-pattern-placeholder)
    (delete-region start (point))
    (tpl-expand-placeholder nil)
                    ; Insert more instances
    (while (tpl-y-or-n-p (concat "More instances of " template-name "? "))
      (tpl-unscan template column)
      (cond
       ((> tpl-ask-expansion-depth 0)
    (progn
      (re-search-backward tpl-pattern-placeholder)
      (tpl-expand-placeholder nil)
      ) ; progn
    ) ; (> tpl-ask-expansion-depth 0)
       ) ; cond
      ) ; while (tpl-y-or-n-p...)
    ) ; let
  ) ; defun tpl-insert-repetition

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-insert-selection (template)
  "Insert a template at point using the selection type TEMPLATE."
                    ; Local Variables
  (let (save-buffer start stop size choice choice-template choice-list
            display-string)
                    ; Body
                    ; Highlight placeholder
    (setq display-string (concat
              tpl-display-begin
              (tpl-token-name template)
              tpl-display-end))
    (insert-before-markers display-string)
    (backward-char (length display-string))
                    ; Prepare menu buffer
    (save-window-excursion
      (setq save-buffer (buffer-name))
      (switch-to-buffer-other-window tpl-menu-buffer)
      (erase-buffer)
                    ; Build the menu
      (tpl-unscan template)
                    ; Size the window
      (goto-char (point-max))
      (setq stop (point))
      (goto-char (point-min))
      (setq start (point))
      (setq size (1+ (count-lines start stop)))
      (setq size (max size window-min-height))
      (if (< size (window-height))
      (shrink-window (- (window-height) size))
    ) ; if
                    ; Allow user to view and select
      (setq choice (menu-mode))
      (set-buffer save-buffer)
      (delete-windows-on tpl-menu-buffer)
      ) ; save-window-excursion
    (bury-buffer tpl-menu-buffer)
    (delete-char (length display-string))
                    ; Insert choice as template or string
    (if choice
    (progn
      (setq choice-list (tpl-parse-choice choice))
      (setq choice-template (nth 1 choice-list))
      (if choice-template
          (tpl-insert-template choice-template)
        ; else
        (insert-before-markers (nth 0 choice-list))
        ) ; choice-template
      ) ; progn
      ; else insert placeholder
      (progn
    (setq display-string (concat tpl-begin-placeholder
                     (tpl-token-name template)
                     tpl-end-placeholder))
    (insert-before-markers display-string)
    (backward-char (length display-string))
    (error "Quit.")
    ) ; progn
      ) ; if choice
    ) ; let
  ) ; defun tpl-insert-selection

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-insert-string-from-buffer (tpl-name display-string &optional buffer)
  "Insert a template at point using the string type TPL-NAME, temporarily
   represented by DISPLAY-STRING.  Optional third argument BUFFER is the
   buffer to search."
                    ; Local Variables
  (let (start string)
                    ; Body
    (if (not buffer)
    (setq buffer
          (read-buffer "tpl-insert-string: Template buffer? "
               tpl-new-template-buffer t))
      ) ; if
    (save-window-excursion
      (set-buffer buffer)
      (goto-char (point-min))
      (if (re-search-forward (concat tpl-begin-template-definition
                     " " tpl-name " ")
                 (point-max) t)
      (progn
        (re-search-forward tpl-begin-template-body)
        (beginning-of-line 2)
        (setq start (point))
        (re-search-forward tpl-end-template-body)
        (end-of-line 0)
        (setq string (buffer-substring start (point)))
        ) ; progn
    ; else
    (error "Could not find template in %s" buffer)
    ) ; if
      ) ; save-window-excursion
    (delete-char (length display-string))
    (insert-before-markers string)
    ) ; let
  ) ; defun tpl-insert-string-from-buffer

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-insert-template (tpl-name)
  "Insert the template TPL-NAME at point."
                    ; Local Variables
  (let (display-string template start template-type looking)
                    ; Body
                    ; Display selected template
    (setq display-string (concat tpl-display-begin tpl-name tpl-display-end))
    (insert-before-markers display-string)
    (backward-char (length display-string))
    (setq looking t)
    (while looking
                    ; Find template.
      (setq template (tpl-find-template tpl-name))
      (if template
      (progn
        (setq looking nil)
                    ; Insert template
        (delete-char (length display-string))
        (setq start (point))
        (setq template-type (tpl-token-type template))
        (cond
         ((equal template-type tpl-sequence-type)
          (progn
        (tpl-unscan template)
        (tpl-find-expansion-destination start (point))
        (cond
         ((< tpl-ask-expansion-depth 0)
          (tpl-delete-placeholders-in-region start (point))
          ) ; (< tpl-ask-expansion-depth 0)
         ((> tpl-ask-expansion-depth 0)
          (progn
            (expand-placeholders-in-region start (point))
            ) ; progn
          ) ; (> tpl-ask-expansion-depth 0)
         ) ; cond
        ) ; progn
          ) ; (equal template-type tpl-sequence-type)
         ((equal template-type tpl-selection-type)
          (progn
        (tpl-insert-selection template)
        ) ; progn
          ) ; (equal template-type tpl-selection-type)
         ((equal template-type tpl-repetition-type)
          (progn
        (tpl-insert-repetition template)
        ) ; progn
          ) ; (equal template-type tpl-repetition-type)
         ((equal template-type tpl-function-type)
          (progn
        (tpl-insert-function template)
        ) ; progn
          ) ; (equal template-type tpl-function-type)
         ((equal template-type tpl-string-type)
          (progn
        (tpl-unscan template)
        ) ; progn
          ) ; (equal template-type tpl-string-type)
         ) ; cond
        ) ; progn
                    ; Else report failure
    (progn
      (if (y-or-n-p "Cannot find template---look in a buffer? ")
          (progn
        (setq looking nil)
        (tpl-insert-string-from-buffer tpl-name display-string)
        ) ; progn
        ; else
        (if (y-or-n-p "Cannot find template---load a template file? ")
        (progn
          (save-some-buffers)
          (load-tpl-file)
          ) ; progn
          ; else
          (progn
        (setq looking nil)
        (error "Gave up looking for template.")
        ) ; progn
          ) ; if (y-or-n-p ...load...)
        ) ; if (y-or-n-p ...look...)
      ) ; progn
    ) ; if template
      ) ; while looking
    ) ; let
  ) ; defun tpl-insert-template

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-lexical-check (input)
  "Check INPUT for validity against lexical definition."
                    ; Local Variables
  (let (result)
                    ; Body
    (if (and (string-match tpl-lexical-pattern input)
         (equal (match-beginning 0) 0)
         (equal (match-end 0) (length input)))
    (setq result t)
      (setq result nil)
      ) ; if
    (if (not result)
    (progn
      (ding)
      (message (concat "String does not match pattern: "
               tpl-lexical-pattern))
      ) ; progn
      ) ; if
                    ; return
    result
    ) ; let
  ) ; defun tpl-lexical-check

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-make-all-templates-template ()
  "Make a template consisting of a selection of all templates.
    Replace existing version if present."
                    ; Local Variables
  (let (name template-tree template-file template-list file-name name-list
         new-template-list)
                    ; Body
    (message "Rebuilding list of all templates...")
                    ; Build name-list
    (setq template-list tpl-local-template-list)
    (setq new-template-list nil)
    (setq name-list nil)
    (while template-list
      (setq template-file (car template-list))
      (setq template-list (cdr template-list))
      (setq file-name (nth 0 template-file))
                    ; Remove existing version if present
      (if (not (string-equal file-name tpl-all-templates-file))
      (progn
        (setq new-template-list
          (append new-template-list (list template-file)))
        (setq name-list
          (append name-list (nth 2 template-file)))
        ) ; progn
    ) ; if
      ) ; while template-list
                    ; Build template
    (save-window-excursion
      (set-buffer tpl-work-buffer)
      (erase-buffer)
      (while name-list
    (setq name (car name-list))
    (setq name-list (cdr name-list))
    (insert (car name) ":")
    (newline)
    ) ; while name-list
      (shell-command-on-region (point-min) (point-max) "sort -u" t)
                    ; Insert preface
      (goto-char (point-min))
      (insert tpl-begin-template-definition " "
          tpl-all-templates-name " "
          tpl-selection-type)
      (newline)
      (beginning-of-line 0)
      (delete-char 1)            ; Remove regular exression anchor
      (end-of-line)
      (newline)
      (insert tpl-begin-template-body)
      (beginning-of-line)
      (delete-char 1)            ; Remove regular exression anchor
                    ; Insert suffix
      (goto-char (point-max))
      (insert tpl-end-template-body)
      (beginning-of-line)
      (delete-char 1)
      (end-of-line)
      (newline)
                    ; Create template
      (goto-char (point-min))
      (setq template-tree (tpl-scan-template))
      ) ; save-window-excursion
    (bury-buffer tpl-work-buffer)
                    ; Rebuild template-list
    (setq tpl-local-template-list
      (append (list (list tpl-all-templates-file
                  (list template-tree) nil))
          new-template-list))
    (setq tpl-all-templates-template-invalid nil)
    (message "Rebuilding list of all templates...Done.")
    ) ; let
  ) ; defun tpl-make-all-templates-template

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-make-completion-list ()
  "Create a completion list of template names for prompting."
                    ; Local Variables
  (let (name completion-list file-list template-file name-list)
                    ; Body
    ; Build completion list
    (setq completion-list nil)
    (setq file-list tpl-local-template-list)
    (while file-list
      (setq template-file (car file-list))
      (setq file-list (cdr file-list))
      (setq name-list (nth 2 template-file))
      (setq completion-list (append completion-list name-list))
      ) ; while file-list
                    ; return
    completion-list
    ) ; let
  ) ; defun tpl-make-completion-list

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-make-keymap ()
  "Make keymap for template-mode."
                    ; Local Variables
  (let ()
                    ; Body
    (setq tpl-saved-map (current-local-map))
    (if (not template-mode-map)
    (progn
      (setq template-mode-map tpl-saved-map)
      (define-key
        template-mode-map "\^c\^t\t" 'expand-symbol)
      (define-key
        template-mode-map "\^c\^ta" 'add-symbol)
      (define-key
        template-mode-map "\^c\^te" 'expand-placeholder)
      (define-key
        template-mode-map "\^c\^tg" 'query-replace-groups)
      (define-key
        template-mode-map "\^c\^tl" 'query-replace-lines)
      (define-key
        template-mode-map "\^c\^tr" 'replace-line-with-placeholder)
      (define-key
        template-mode-map "\^c\^tt" 'generate-template)
      (define-key
        template-mode-map "\^c\^tu" 'unwrap-template-around-point)
      (define-key
        template-mode-map "\^c\^tw" 'wrap-template-around-word)
      (define-key
        template-mode-map "\^c\^tW" 'wrap-template-around-line)
      (define-key
        template-mode-map "\^c\^t\^e" 'expand-placeholders-in-region)
      (define-key
        template-mode-map "\^c\^t\^h" 'describe-template-mode)
      (define-key
        template-mode-map "\^c\^t\^k" 'delete-placeholder)
      (define-key
        template-mode-map "\^c\^t\^n" 'next-placeholder)
      (define-key
        template-mode-map "\^c\^t\^p" 'previous-placeholder)
      (define-key
        template-mode-map "\^c\^t\^r" 'replace-region-with-placeholder)
      (define-key
        template-mode-map "\^c\^t\^u" 'rewrap-template-around-point)
      (define-key
        template-mode-map "\^c\^t\^w" 'wrap-template-around-region)
      (define-key
        template-mode-map "\^c\^t?" 'generate-any-template)
      ) ; progn
      ) ; if
    (use-local-map template-mode-map)
    ) ; let
  ) ; defun tpl-make-keymap

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-make-mode-entry (name file)
  "Constructor for mode entries from NAME FILE."
                    ; Local Variables
  (let ()
                    ; Body
    (list (list 'name name) (list 'file file))
    ) ; let
  ) ; defun tpl-make-mode-entry

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-make-placeholder-name ()
  "Create a name for a new template by searching for the first symbol
    after point."
                    ; Local Variables
  (let ()
                    ; Body
    (save-excursion
      (if (re-search-forward tpl-pattern-symbol nil t)
      (progn
        (setq tpl-formed-placeholder-name
          (buffer-substring (match-beginning 0) (match-end 0)))
        ) ; progn
    ; else
    (progn
      (setq tpl-formed-placeholder-name tpl-next-placeholder-name)
      (tpl-increment-next-placeholder-name)
      ) ; progn
    ) ; if
      ) ; save-excursion
    ) ; let
  ) ; defun tpl-make-placeholder-name

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-make-template-entry (name templates)
  "Constructor for mode entries from NAME TEMPLATES."
                    ; Local Variables
  (let ()
                    ; Body
    (list (list 'name name) (list 'templates templates))
    ) ; let
  ) ; defun tpl-make-template-entry

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-make-template-list (file &optional buffer)
  "Create a template list from the templates in FILE.
    Optional second argument non-nil means use a buffer, not a file."
                    ; Local Variables
  (let (template-list template-tree template-name
              name-list msg table root-name)
                    ; Body
    (setq msg (concat "Loading templates in " file ": "))
    (save-window-excursion
      (setq table (syntax-table))
      (set-buffer tpl-work-buffer)
      (erase-buffer)
      (if buffer
      (insert-buffer file)
    ; else
    (insert-file file)
    ) ;if buffer
      (set-syntax-table table)
      (goto-char (point-min))
      (setq name-list nil)
      (while (re-search-forward
          tpl-begin-template-definition (point-max) t)
    (beginning-of-line)
    (setq template-tree (tpl-scan-template))
    (setq template-list (append template-list (list template-tree)))
    (setq template-name (tpl-token-name template-tree))
    (message (concat msg template-name "..."))
    (if (not (equal tpl-lexical-type
            (tpl-token-type template-tree)))
        (setq name-list
          (append name-list (list (list template-name))))
      ) ; if
    ) ; while (re-search-forward...)
      (setq template-list
        (list (tpl-root-of-file-name (file-name-nondirectory file))
          template-list name-list))
      ) ; save-window-excursion
    (bury-buffer tpl-work-buffer)
    (message (concat msg "Done."))
                    ; return
    template-list
    ) ; let
  ) ; defun tpl-make-template-list

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-mode-file (mode-entry)
  "Selector for file field of MODE-ENTRY."
                    ; Local Variables
  (let ()
                    ; Body
    (car (cdr (assq 'file mode-entry)))
    ) ; let
  ) ; defun tpl-mode-file

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-mode-match  (mode-nm list)
  "Find mode-entry that matches MODE-NM in LIST."
                    ; Local Variables
  (let (entry)
                    ; Body
    (while list
      (setq entry (car list))
      (setq list (cdr list))
      (if (equal (tpl-mode-name entry) mode-nm)
      (setq list nil)
    ; else
    (setq entry nil)
    ) ; if
      ) ; while
                    ; return
    entry
    ) ; let
  ) ; defun tpl-mode-match

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-mode-name (mode-entry)
  "Selector for name field of MODE-ENTRY."
                    ; Local Variables
  (let ()
                    ; Body
    (car (cdr (assq 'name mode-entry)))
    ) ; let
  ) ; defun tpl-mode-name

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-mode-templates (mode-entry)
  "Selector for templates field of MODE-ENTRY."
                    ; Local Variables
  (let ()
                    ; Body
    (car (cdr (assq 'templates mode-entry)))
    ) ; let
  ) ; defun tpl-mode-templates

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-parse-choice (line)
  "Break menu LINE into component parts: (string template) or (string nil)."
                    ; Local Variables
  (let (string-part template-part end-string end-template)
                    ; Body
                    ; Line =
                    ; "abc" is string "abc"
                    ; "abc:" is template "abc"
                    ; "abc:def" is template "def"
                    ; ";" begins comment area
    (setq end-string (string-match tpl-pattern-symbol line))
    (setq string-part (substring line 0 (match-end 0)))
    (setq line (substring line (match-end 0)))
    (setq end-string (string-match "^\\(\\s \\)*:\\(\\s \\)*" line))
    (if end-string
    (progn
      (setq line (substring line (match-end 0)))
      (setq end-string (string-match
                (concat "^" tpl-pattern-symbol) line))
      (if end-string
          (setq template-part (substring line 0 (match-end 0)))
        ; else
        (setq template-part string-part)
        ) ; if end-template
      ) ; progn
      ; else
      (progn
    (setq template-part nil)
    ) ; progn
      ) ; if end-string
    (list string-part template-part)
    ) ; let
  ) ; defun tpl-parse-choice

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-rebuild-global-template-list (name templates)
  "Rebuild global template list, changing major mode NAME to
    include TEMPLATES."
                    ; Local Variables
  (let (mode-list mode-item entry result)
                    ; Body
    (setq result nil)
    (setq entry nil)
    (setq mode-list tpl-global-template-list)
    (while (and mode-list (not entry))
      (setq mode-item (car mode-list))
      (setq mode-list (cdr mode-list))
      (if (string-equal (tpl-mode-name mode-item) name)
      (setq entry mode-item)
    ; else
    (setq result (append result (list mode-item)))
    ) ; if (equal (tpl-mode-name mode-item) name)
      ) ; while mode-list
    (if (not entry)
    (progn
      (setq tpl-global-template-list
        (append result
            (list (tpl-make-template-entry name templates))))
      (message "Added templates for %s." name)
      ) ; progn
      ; else
      (if (or (not (tpl-mode-templates mode-item))
          (y-or-n-p "Replace existing templates for this mode? "))
      (progn
        (setq result
          (append result (list (tpl-make-template-entry name
                                templates))))
        (setq result (append result mode-list))
        (setq tpl-global-template-list result)
        (message "Added templates for %s." name)
        ) ; progn
    ) ; if
      ) ; if
    ) ; let
  ) ; defun tpl-rebuild-global-template-list

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-replace-group (from to)
  "Replace current region with a temporary placeholder.
    Arguments FROM and TO are ignored.  (They are only needed
    for compatibility with other replacement functions.)"
                    ; Local Variables
  (let (name)
                    ; Body
    (if tpl-get-placeholder-name-in-context
    (setq name nil)
      ; else
      (progn
    (setq name tpl-next-placeholder-name)
    (tpl-increment-next-placeholder-name)
    ) ; progn
      ) ; if tpl-get-placeholder-name-in-context
    (replace-region-with-placeholder (mark) (point) name
                     "new.tpl" nil)
    ) ; let
  ) ; defun tpl-replace-group

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-replace-line (from to)
  "Replace current line with a temporary placeholder.
    Arguments FROM and TO are ignored.  (They are only needed
    for compatibility with other replacement functions.)"
                    ; Local Variables
  (let (name)
                    ; Body
    (if tpl-get-placeholder-name-in-context
    (setq name nil)
      ; else
      (progn
    (setq name tpl-next-placeholder-name)
    (tpl-increment-next-placeholder-name)
    ) ; progn
      ) ; if tpl-get-placeholder-name-in-context
    (replace-line-with-placeholder 1 name "new.tpl" nil)
    ) ; let
  ) ; defun tpl-replace-line

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-root-of-file-name (file)
  "Find the root of FILE as a template file name."
                    ; Local Variables
  (let (result)
                    ; Body
    (cond
     ((and (> (length file) 7)
       (equal (substring file -7) "tpl.elc"))
      (setq result (substring file 0 -7))
      )
     ((and (> (length file) 6)
       (equal (substring file -6) "tpl.el"))
      (setq result (substring file 0 -6))
      )
     ((and (> (length file) 4)
       (equal (substring file -4) ".tpl"))
      (setq result (substring file 0 -4))
      )
     (t
      (setq result file)
      )
     ) ; cond
                    ; return
    result
    ) ; let
  ) ; defun tpl-root-of-file-name

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-undo-keymap ()
  "Undo keymap for template-mode."
                    ; Local Variables
  (let ()
                    ; Body
    (use-local-map tpl-saved-map)
    ) ; let
  ) ; defun tpl-undo-keymap

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-unwrap-template (template &optional arg)
  "Find the enclosing TEMPLATE around point and replace it with
    whatever is matching the destination placeholder.
    Optional second argument non-nil causes mark to be placed
    at the beginning of the resulting region."
                    ; Local Variables
  (let (origin wrapper-pair wrapper-begin wrapper-end indent-amount
           prefix another-wrapper-end start match-start
           match-stop-marker)
                    ; Body
    (setq origin (point))
    (setq match-stop-marker (make-marker))
    (setq wrapper-pair (tpl-find-wrappers template))
    (setq wrapper-begin (nth 0 wrapper-pair))
    (setq wrapper-end (nth 1 wrapper-pair))
    (setq indent-amount (nth 2 wrapper-pair))
    (if (search-backward wrapper-begin (point-min) t)
    (progn
      (setq start (point))
      (search-forward wrapper-begin)
      (delete-region start (point))
      (setq match-start (point))
                    ; Get prefix of line for another try
                    ;   at matching ending part.
      (beginning-of-line nil)
      (setq prefix (buffer-substring (point) match-start))
      (goto-char match-start)
      (setq another-wrapper-end (concat (substring wrapper-end 0 1)
                        prefix
                        (substring wrapper-end 1)))
      ) ; progn
      ; else
      (error "Enclosing template not found.")
      ) ; if
    (if (search-forward wrapper-end (point-max) t)
    (progn
      (setq start (point))
      (search-backward wrapper-end (point-min) t)
      (delete-region (point) start)
      (set-marker match-stop-marker (point))
      ) ; progn
      ; else
                    ; This is a hack to fix indented
                    ;   matches.
      (if (search-forward another-wrapper-end (point-max) t)
      (progn
        (setq start (point))
        (search-backward another-wrapper-end (point-min) t)
        (delete-region (point) start)
        (set-marker match-stop-marker (point))
        (goto-char match-start)
        (delete-backward-char (length prefix))
        (setq match-start (- match-start (length prefix)))
        ) ; progn
    ; else
    (progn
      (goto-char origin)
      (error "End of enclosing template not found.")
      ) ; progn
    ) ; if ...another...
      ) ; if
    (goto-char match-start)
    (forward-line 1)
    (if (< (point) (marker-position match-stop-marker))
    (indent-rigidly (point) (marker-position match-stop-marker)
            (- 0 indent-amount))
      ) ; if
    (goto-char (marker-position match-stop-marker))
    (set-marker match-stop-marker nil)
    (if arg
    (push-mark match-start)
      ) ; if arg
    ) ; let
  ) ; defun tpl-unwrap-template

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-wrap-template (start stop template)
  "Replace the region between START and STOP with TEMPLATE,
    reinserting the replaced region at the destination placeholder.
    The region is indented rigidly at its insertion column."
                    ; Local Variables
  (let (save-expand-option region start-column orig-column)
                    ; Body
    (setq save-expand-option tpl-ask-expansion-depth)
    (setq tpl-ask-expansion-depth 0)
    (setq region (buffer-substring start stop))
    (delete-region start stop)
    (goto-char start)
    (setq orig-column (current-column))
    (unwind-protect            ; Protect against nonexistent template
    (tpl-generate template)
      (setq start (point))
      (setq start-column (current-column))
      (insert region)
      (indent-rigidly start (point) (- start-column orig-column))
      (setq tpl-ask-expansion-depth save-expand-option)
      ) ; unwind-protect
    (message "Done.")
    ) ; let
  ) ; defun tpl-wrap-template

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

(defun tpl-y-or-n-p (msg)
  "Display MSG and await positive ('y') or negative ('n') response.
    Differs from 'y-or-n-p' in that it leaves the cursor in the active
    window, rather than moving to the mode-line."
                    ; Local Variables
  (let (answered prompt reply result)
                    ; Body
    (setq answered nil)
    (setq prompt (concat msg "(y or n) "))
    (while (not answered)
      (message prompt)
      (setq reply (read-char))
      (cond
       ((char-equal reply ?y)
    (setq answered t)
    (setq result t)
    ) ; (char-equal reply ?y)
       ((char-equal reply ? )
    (setq answered t)
    (setq result t)
    ) ; (char-equal reply ? )
       ((char-equal reply ?n)
    (setq answered t)
    (setq result nil)
    ) ; (char-equal reply ?n)
       ((char-equal reply ?\177)
    (setq answered t)
    (setq result nil)
    ) ; (char-equal reply ?\177)
       (t
    (ding)
    (setq prompt (concat "Please respond 'y' or 'n'.  "
                 msg "(y or n) "))
    ) ; t
       ) ; cond
      ) ; while (not answered)
                    ; return
    result
    ) ; let
  ) ; defun tpl-y-or-n-p

;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

;;; end of tplhelper.el