rsalz@uunet.UU.NET (Rich Salz) (10/06/87)
Submitted-by: "Mark A. Ardis" <maa@sei.cmu.edu>
Posting-number: Volume 11, Issue 93
Archive-name: templates/part03
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create:
# tplhelper.el
export PATH; PATH=/bin:/usr/bin:$PATH
echo shar: "extracting 'tplhelper.el'" '(45072 characters)'
if test -f 'tplhelper.el'
then
echo shar: "will not over-write existing file 'tplhelper.el'"
else
sed 's/^X//' << \SHAR_EOF > 'tplhelper.el'
X;;; tplhelper.el -- Helper functions for template-mode.
X;;; Copyright (C) 1987 Mark A. Ardis.
X
X(provide 'tplhelper)
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-blank-line ()
X "Returns t if current line contains only whitespace.
X Otherwise, returns nil."
X ; Local Variables
X (let (result)
X ; Body
X (save-excursion
X (beginning-of-line)
X (if (eolp)
X (setq result t)
X ; else
X (progn
X (re-search-forward tpl-pattern-whitespace (point-max) t)
X (if (eolp)
X (setq result t)
X (setq result nil)
X ) ; if
X ) ; progn
X ) ; if
X ) ; save
X ; return
X result
X ) ; let
X ) ; defun tpl-blank-line
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-build-template-list ()
X "Build template-list, using current major mode."
X ; Local Variables
X (let (mode-entry template-list)
X ; Body
X (setq tpl-local-template-list
X (list (tpl-mode-templates
X (tpl-mode-match 'generic tpl-global-template-list))))
X ; Use loaded templates if available
X (setq template-list
X (tpl-mode-templates
X (tpl-mode-match major-mode tpl-global-template-list)))
X (if template-list
X (setq tpl-local-template-list
X (cons template-list tpl-local-template-list))
X ; else
X (progn
X (setq mode-entry (tpl-mode-match major-mode tpl-auto-template-alist))
X (if mode-entry
X (progn
X (load-tpl-library (tpl-mode-file mode-entry) major-mode)
X ) ; progn
X ; else
X (message "No templates found for this mode.")
X ) ; if mode-entry
X ) ; progn
X ) ; if template-list
X (if tpl-rebuild-all-templates-template
X (tpl-make-all-templates-template)
X ) ; if
X ) ; let
X ) ; defun tpl-build-template-list
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-delete-placeholders-in-region (start stop)
X "Delete all placeholders in region between START and STOP."
X ; Local Variables
X (let (stop-marker)
X ; Body
X (setq stop-marker (make-marker))
X (set-marker stop-marker stop)
X (goto-char start)
X (while (re-search-forward tpl-pattern-placeholder
X (marker-position stop-marker) t)
X (re-search-backward tpl-pattern-placeholder)
X (delete-placeholder)
X ) ; while
X (set-marker stop-marker nil)
X ) ; let
X ) ; defun tpl-delete-placeholders-in-region
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-expand-lexical-type (name stop)
X "Expand the lexical placeholder NAME at point. Replaces all instances
X of identical placeholders before STOP with the same value.
X Checks for match with lexical description."
X ; Local Variables
X (let (save-hook)
X ; Body
X (if (boundp 'sym-check-validity-hook)
X (setq save-hook sym-check-validity-hook)
X (setq save-hook nil)
X ) ; if
X (setq sym-check-validity-hook 'tpl-lexical-check)
X (setq tpl-lexical-pattern (tpl-find-value-of-template name))
X (if tpl-lexical-pattern
X (tpl-expand-text-type stop)
X (error "Cannot find template.")
X ) ; if
X (setq sym-check-validity-hook save-hook)
X ) ; let
X ) ; defun tpl-expand-lexical-type
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-expand-placeholder (stop)
X "Expand the placeholder at point. Replace identical occurrences
X of text placeholders before STOP with the same value."
X ; Local Variables
X (let (placeholder template-name start placeholder-name)
X ; Body
X (setq start (point))
X ; Process placeholder
X (setq placeholder (tpl-scan-placeholder))
X (setq template-name (tpl-token-name placeholder))
X (setq placeholder-name (tpl-token-value placeholder))
X (cond
X ((equal template-name "text")
X (tpl-expand-text-type stop)
X ) ; (equal template-name "text")
X ((equal template-name "textenter")
X (tpl-expand-textenter-type stop)
X ) ; (equal template-name "textenter")
X ((equal template-name "textlong")
X (tpl-expand-textlong-type placeholder-name)
X ) ; (equal template-name "textlong")
X ((equal template-name tpl-destination-symbol)
X (progn
X (re-search-forward tpl-pattern-placeholder)
X (ding)
X (message "Cannot expand destination placeholder.")
X ) ; progn
X ) ; (equal template-name "textlong")
X (t
X (if (equal tpl-lexical-type
X (tpl-find-type-of-template template-name))
X (tpl-expand-lexical-type template-name stop)
X ; else
X (progn
X (re-search-forward tpl-pattern-placeholder)
X (delete-region start (point))
X (tpl-insert-template template-name)
X ) ; progn
X ) ; if
X ) ; t
X ) ; cond
X ) ; let
X ) ; defun tpl-expand-placeholder
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-expand-text-type (stop)
X "Expand the text placeholder at point. Replace identical placeholders
X before STOP with the same value. Return that value."
X ; Local Variables
X (let (start stop-marker placeholder-string sym-input)
X ; Body
X (setq start (point))
X (if stop
X (progn
X (setq stop-marker (make-marker))
X (set-marker stop-marker stop)
X ) ; progn
X ) ; if stop
X (re-search-forward tpl-pattern-placeholder)
X (setq placeholder-string (buffer-substring start (point)))
X (goto-char start)
X (setq sym-input (sym-read-string
X (concat "Replace " placeholder-string " with what? ")
X placeholder-string))
X (if (= (length sym-input) 0)
X (re-search-forward placeholder-string)
X ; else
X (if stop
X (progn
X (setq start (point))
X ; Replace all identical placeholders
X (while (re-search-forward placeholder-string
X (marker-position stop-marker) t)
X (re-search-backward placeholder-string)
X (insert-before-markers sym-input)
X (delete-char (length placeholder-string))
X ) ; while (re-search-forward...)
X (goto-char start)
X ) ; progn
X ) ; if stop
X ) ; if (= (length sym-input) 0)
X ; return
X sym-input
X ) ; let
X ) ; defun tpl-expand-text-type
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-expand-textenter-type (stop)
X "Expand the text placeholder at point. Replace identical placeholders
X before STOP with the same value. Enter that value in the symbol
X table."
X ; Local Variables
X (let (value)
X ; Body
X (setq value (tpl-expand-text-type stop))
X (sym-enter-id value)
X ) ; let
X ) ; defun tpl-expand-textenter-type
X
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-expand-textlong-type (name)
X "Expand the textlong placeholder at point called NAME."
X ; Local Variables
X (let (start display-string save-buffer new-string start-column)
X ; Body
X ; Highlight placeholder
X (setq start (point))
X (re-search-forward tpl-pattern-placeholder)
X (delete-region start (point))
X (setq display-string (concat tpl-display-begin name tpl-display-end))
X (insert-before-markers display-string)
X (backward-char (length display-string))
X ; Save current location
X (setq start (point))
X ; Prepare buffer
X (save-window-excursion
X (setq save-buffer (buffer-name))
X (switch-to-buffer-other-window tpl-textlong-buffer)
X (erase-buffer)
X (shrink-window 5)
X ; Wait for return from recursive edit
X (message (substitute-command-keys
X "Type replacement and exit with \\[exit-recursive-edit]"))
X (recursive-edit)
X ; Get new value and insert
X (setq new-string (buffer-substring (point-min) (point-max)))
X (set-buffer save-buffer)
X (delete-windows-on tpl-textlong-buffer)
X ) ; save-window-excursion
X (bury-buffer tpl-textlong-buffer)
X ; Return to proper location
X (goto-char start)
X (delete-char (length display-string))
X (setq start-column (current-column))
X (setq start (point))
X (insert-before-markers new-string)
X (indent-rigidly start (point) start-column)
X ) ; let
X ) ; defun tpl-expand-textlong-type
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-find-end-of-group ()
X "Find the end of a group defined for query-replace-groups."
X ; Local Variables
X (let ()
X ; Body
X (if tpl-form-placeholder-name-from-context
X (tpl-make-placeholder-name)
X ) ; if tpl-form-placeholder-name-from-context
X (if tpl-include-prefix-in-groups
X (beginning-of-line nil)
X ) ; if tpl-include-prefix-in-groups
X (set-mark (point))
X (end-of-line nil)
X (re-search-forward tpl-end-group nil "not-t")
X (if tpl-verify-end-of-group
X (progn
X (message
X (concat "Position point AFTER end of group and exit ("
X (substitute-command-keys "\\[exit-recursive-edit]")
X ")."))
X (unwind-protect
X (recursive-edit)
X ) ; unwind-protect
X ) ; progn
X ) ; if tpl-verify-end-of-group
X (end-of-line 0)
X ) ; let
X ) ; defun tpl-find-end-of-group
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-find-expansion-destination (start stop)
X "Delete special destination placeholder between START and STOP
X and set destination marker if a destination needs to be found."
X ; Local Variables
X (let (stop-marker)
X ; Body
X (goto-char start)
X (setq stop-marker (make-marker))
X (set-marker stop-marker stop)
X (while (re-search-forward tpl-destination-placeholder stop stop)
X (progn
X (re-search-backward tpl-pattern-placeholder)
X (delete-placeholder)
X (if tpl-destination-needed
X (progn
X (set-marker tpl-destination-marker (point))
X (setq tpl-destination-needed nil)
X ) ; progn
X ) ; if tpl-destination-needed
X ) ; progn
X ) ; while (re-search-forward tpl-destination-placeholder stop stop)
X (goto-char (marker-position stop-marker))
X (set-marker stop-marker nil)
X ) ; let
X ) ; defun tpl-find-expansion-destination
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-find-next-group ()
X "Find the end of a group defined for query-replace-groups.
X Do not interact with user."
X ; Local Variables
X (let ()
X ; Body
X (end-of-line nil)
X (re-search-forward tpl-end-group nil "not-t")
X (end-of-line 0)
X ) ; let
X ) ; defun tpl-find-next-group
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-find-template-file (file)
X "Find FILE using the 'tpl-load-path value."
X ; Local Variables
X (let (tpl-name compiled-name dir-list looking)
X ; Body
X (setq tpl-name (concat file ".tpl"))
X (setq compiled-name (concat file "tpl.elc"))
X (setq name nil)
X (setq looking t)
X ; First try compiled versions
X (setq dir-list tpl-load-path)
X (while (and looking dir-list)
X (setq name (concat (car dir-list) "/" compiled-name))
X (setq dir-list (cdr dir-list))
X (if (file-readable-p name)
X (setq looking nil)
X ) ; if
X ) ; while
X ; Second, try uncompiled
X (setq dir-list tpl-load-path)
X (while (and looking dir-list)
X (setq name (concat (car dir-list) "/" tpl-name))
X (setq dir-list (cdr dir-list))
X (if (file-readable-p name)
X (setq looking nil)
X ) ; if
X ) ; while
X ; Last, try literal name
X (setq dir-list tpl-load-path)
X (while (and looking dir-list)
X (setq name (concat (car dir-list) "/" file))
X (setq dir-list (cdr dir-list))
X (if (file-readable-p name)
X (setq looking nil)
X ) ; if
X ) ; while
X ; return
X name
X ) ; let
X ) ; defun tpl-find-template-file
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-find-template (tpl-name)
X "Find template TPL_NAME and return template or nil (if not found)."
X ; Local Variables
X (let (found file-list template-file template-list template template-name)
X ; Body
X (setq found nil)
X (setq file-list tpl-local-template-list)
X (while (and file-list (not found))
X (setq template-file (car file-list))
X (setq file-list (cdr file-list))
X (setq template-list (nth 1 template-file))
X (while (and template-list (not found))
X (setq template (car template-list))
X (setq template-list (cdr template-list))
X (setq template-name (tpl-token-name template))
X (if (equal template-name tpl-name)
X (setq found template)
X ) ; if (equal template-name tpl-name)
X ) ; while (and template-list (not found))
X ) ; while (and file-list (not found))
X ; return
X found
X ) ; let
X ) ; defun tpl-find-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-find-type-of-template (name)
X "Find template NAME and return its type or nil (if not found)."
X ; Local Variables
X (let (template result)
X ; Body
X (setq template (tpl-find-template name))
X (if template
X (setq result (tpl-token-type template))
X (setq result nil)
X ) ; if
X ; return
X result
X ) ; let
X ) ; defun tpl-find-type-of-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-find-value-of-template (name)
X "Find template NAME and return its value or nil (if not found)."
X ; Local Variables
X (let (template result)
X ; Body
X (setq template (tpl-find-template name))
X (if template
X (setq result (tpl-token-value template))
X (setq result nil)
X ) ; if
X ; return
X result
X ) ; let
X ) ; defun tpl-find-value-of-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-find-wrappers (tpl-name)
X "Find the beginning and ending part of TPL-NAME that encloses a
X destination placeholder."
X ; Local Variables
X (let (msg template midpoint result)
X ; Body
X (setq msg nil)
X (setq template (tpl-find-template tpl-name))
X (save-excursion
X (set-buffer tpl-work-buffer)
X (erase-buffer)
X (if template
X (progn
X (tpl-unscan template)
X (goto-char (point-min))
X (if (re-search-forward tpl-destination-placeholder
X (point-max) t)
X (progn
X (delete-region (match-beginning 0) (match-end 0))
X (setq midpoint (point))
X ) ; progn
X ; else
X (progn
X (setq msg "Template does not contain a destination placeholder.")
X ) ; progn
X ) ; if
X ) ; progn
X ; else
X (progn
X (setq msg "Cannot find template.")
X ) ; progn
X ) ; if template
X (if (not msg)
X (setq result (list (buffer-substring 1 midpoint)
X (buffer-substring midpoint (point-max))
X (current-column)))
X ) ; if
X ) ; save-excursion
X (bury-buffer tpl-work-buffer)
X (if msg
X (error msg)
X ) ; if
X ; return
X result
X ) ; let
X ) ; defun tpl-find-wrappers
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-generate (tpl-name)
X "Insert and expand the template TPL-NAME at point."
X ; Local Variables
X (let (start stop)
X ; Body
X ; Insert and expand template
X (setq start (point))
X (insert-before-markers tpl-begin-placeholder tpl-name tpl-end-placeholder)
X (goto-char start)
X (setq tpl-destination-needed t)
X (message "Looking for template...")
X (tpl-expand-placeholder nil)
X (setq stop (point))
X (if (not tpl-destination-needed)
X (progn
X (goto-char (marker-position tpl-destination-marker))
X (set-marker tpl-destination-marker nil)
X ) ; progn
X ; else
X (progn
X (setq tpl-destination-needed nil)
X (goto-char start)
X (if (re-search-forward tpl-pattern-placeholder stop stop)
X (re-search-backward tpl-pattern-placeholder)
X ) ; if
X ) ; progn
X ) ; if (not tpl-destination-needed)
X (message "%s" "Done.")
X ) ; let
X ) ; defun tpl-generate
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-get-placeholder-name ()
X "Prompt for a placeholder name. If none supplied, use temporary
X name and regenerate another unique name. Return the name."
X ; Local Variables
X (let (name)
X ; Body
X (if tpl-query-flag
X (progn
X (setq name (read-string
X (concat "Template name? ("
X tpl-next-placeholder-name ") ")))
X ) ; progn
X ; else
X (setq name "")
X ) ; if tpl-query-flag
X (if (equal name "")
X (progn
X (setq name tpl-next-placeholder-name)
X (tpl-increment-next-placeholder-name)
X ) ; progn
X ) ; if (equal name "")
X ; return
X name
X ) ; let
X ) ; tpl-get-placeholder-name
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-increment-next-placeholder-name ()
X "Increment unique name for temporary placeholders."
X ; Local Variables
X (let ()
X ; Body
X (setq tpl-next-placeholder-number
X (1+ tpl-next-placeholder-number))
X (setq tpl-next-placeholder-name
X (concat tpl-temporary-placeholder-name
X tpl-next-placeholder-number))
X ) ; let
X ) ; defun tpl-increment-next-placeholder-name
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-initialize-modes ()
X "Create initial Alist of major modes and their associated template files.
X Calls 'template-mode-load-hook' if it is defined."
X ; Local Variables
X (let ()
X ; Body
X (or (assq 'template-mode minor-mode-alist)
X (setq minor-mode-alist
X (cons '(template-mode " Template") minor-mode-alist)))
X (setq tpl-auto-template-alist
X (list
X (tpl-make-mode-entry 'awk-mode "awk")
X (tpl-make-mode-entry 'bib-mode "bib")
X (tpl-make-mode-entry 'c-mode "c")
X (tpl-make-mode-entry 'emacs-lisp-mode "elisp")
X (tpl-make-mode-entry 'generic "generic")
X (tpl-make-mode-entry 'LaTeX-mode "latex")
X ; Should have another set of templates
X ; for Lisp
X (tpl-make-mode-entry 'lisp-mode "elisp")
X (tpl-make-mode-entry 'pascal-mode "pascal")
X (tpl-make-mode-entry 'scribe-mode "scribe")
X (tpl-make-mode-entry 'texinfo-mode "texinfo")
X ; Should have another set of templates
X ; for TeX
X (tpl-make-mode-entry 'plain-TeX-mode "latex")
X ))
X (setq tpl-local-template-list nil)
X (get-buffer-create tpl-menu-buffer)
X (get-buffer-create tpl-textlong-buffer)
X (get-buffer-create tpl-work-buffer)
X (bury-buffer tpl-menu-buffer)
X (bury-buffer tpl-textlong-buffer)
X (bury-buffer tpl-work-buffer)
X (tpl-initialize-scan)
X (load-tpl-library "generic" 'generic)
X (and (boundp 'template-mode-load-hook)
X template-mode-load-hook
X (funcall template-mode-load-hook))
X ) ; let
X ) ; defun tpl-initialize-modes
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-insert-function (template)
X "Insert a template at point using the function type TEMPLATE."
X ; Local Variables
X (let (start stop-marker result save-depth)
X ; Body
X (setq start (point))
X (setq stop-marker (make-marker))
X (insert (tpl-token-value template))
X (set-marker stop-marker (point))
X ; Temporarily expand placeholders
X ; without asking
X (setq save-depth tpl-ask-expansion-depth)
X (setq tpl-ask-expansion-depth 10)
X (expand-placeholders-in-region start (point))
X (setq tpl-ask-expansion-depth save-depth)
X ; Evaluate result
X (goto-char start)
X (save-excursion
X (setq result (eval (read (current-buffer))))
X ) ; save-excursion
X ; Remove placeholder and insert result
X (delete-region start (marker-position stop-marker))
X (set-marker stop-marker nil)
X (insert result)
X ) ; let
X ) ; defun tpl-insert-function
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-insert-repetition (template)
X "Insert at point instances of the repetition type TEMPLATE."
X ; Local Variables
X (let (start template-name column)
X ; Body
X (setq start (point))
X (setq column (current-column))
X (setq template-name (tpl-token-name template))
X ; Insert first instance
X (tpl-unscan template)
X (re-search-backward tpl-pattern-placeholder)
X (delete-region start (point))
X (tpl-expand-placeholder nil)
X ; Insert more instances
X (while (tpl-y-or-n-p (concat "More instances of " template-name "? "))
X (tpl-unscan template column)
X (cond
X ((> tpl-ask-expansion-depth 0)
X (progn
X (re-search-backward tpl-pattern-placeholder)
X (tpl-expand-placeholder nil)
X ) ; progn
X ) ; (> tpl-ask-expansion-depth 0)
X ) ; cond
X ) ; while (tpl-y-or-n-p...)
X ) ; let
X ) ; defun tpl-insert-repetition
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-insert-selection (template)
X "Insert a template at point using the selection type TEMPLATE."
X ; Local Variables
X (let (save-buffer start stop size choice choice-template choice-list
X display-string)
X ; Body
X ; Highlight placeholder
X (setq display-string (concat
X tpl-display-begin
X (tpl-token-name template)
X tpl-display-end))
X (insert-before-markers display-string)
X (backward-char (length display-string))
X ; Prepare menu buffer
X (save-window-excursion
X (setq save-buffer (buffer-name))
X (switch-to-buffer-other-window tpl-menu-buffer)
X (erase-buffer)
X ; Build the menu
X (tpl-unscan template)
X ; Size the window
X (goto-char (point-max))
X (setq stop (point))
X (goto-char (point-min))
X (setq start (point))
X (setq size (1+ (count-lines start stop)))
X (setq size (max size window-min-height))
X (if (< size (window-height))
X (shrink-window (- (window-height) size))
X ) ; if
X ; Allow user to view and select
X (setq choice (menu-mode))
X (set-buffer save-buffer)
X (delete-windows-on tpl-menu-buffer)
X ) ; save-window-excursion
X (bury-buffer tpl-menu-buffer)
X (delete-char (length display-string))
X ; Insert choice as template or string
X (if choice
X (progn
X (setq choice-list (tpl-parse-choice choice))
X (setq choice-template (nth 1 choice-list))
X (if choice-template
X (tpl-insert-template choice-template)
X ; else
X (insert-before-markers (nth 0 choice-list))
X ) ; choice-template
X ) ; progn
X ; else insert placeholder
X (progn
X (setq display-string (concat tpl-begin-placeholder
X (tpl-token-name template)
X tpl-end-placeholder))
X (insert-before-markers display-string)
X (backward-char (length display-string))
X (error "Quit.")
X ) ; progn
X ) ; if choice
X ) ; let
X ) ; defun tpl-insert-selection
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-insert-string-from-buffer (tpl-name display-string &optional buffer)
X "Insert a template at point using the string type TPL-NAME, temporarily
X represented by DISPLAY-STRING. Optional third argument BUFFER is the
X buffer to search."
X ; Local Variables
X (let (start string)
X ; Body
X (if (not buffer)
X (setq buffer
X (read-buffer "tpl-insert-string: Template buffer? "
X tpl-new-template-buffer t))
X ) ; if
X (save-window-excursion
X (set-buffer buffer)
X (goto-char (point-min))
X (if (re-search-forward (concat tpl-begin-template-definition
X " " tpl-name " ")
X (point-max) t)
X (progn
X (re-search-forward tpl-begin-template-body)
X (beginning-of-line 2)
X (setq start (point))
X (re-search-forward tpl-end-template-body)
X (end-of-line 0)
X (setq string (buffer-substring start (point)))
X ) ; progn
X ; else
X (error "Could not find template in %s" buffer)
X ) ; if
X ) ; save-window-excursion
X (delete-char (length display-string))
X (insert-before-markers string)
X ) ; let
X ) ; defun tpl-insert-string-from-buffer
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-insert-template (tpl-name)
X "Insert the template TPL-NAME at point."
X ; Local Variables
X (let (display-string template start template-type looking)
X ; Body
X ; Display selected template
X (setq display-string (concat tpl-display-begin tpl-name tpl-display-end))
X (insert-before-markers display-string)
X (backward-char (length display-string))
X (setq looking t)
X (while looking
X ; Find template.
X (setq template (tpl-find-template tpl-name))
X (if template
X (progn
X (setq looking nil)
X ; Insert template
X (delete-char (length display-string))
X (setq start (point))
X (setq template-type (tpl-token-type template))
X (cond
X ((equal template-type tpl-sequence-type)
X (progn
X (tpl-unscan template)
X (tpl-find-expansion-destination start (point))
X (cond
X ((< tpl-ask-expansion-depth 0)
X (tpl-delete-placeholders-in-region start (point))
X ) ; (< tpl-ask-expansion-depth 0)
X ((> tpl-ask-expansion-depth 0)
X (progn
X (expand-placeholders-in-region start (point))
X ) ; progn
X ) ; (> tpl-ask-expansion-depth 0)
X ) ; cond
X ) ; progn
X ) ; (equal template-type tpl-sequence-type)
X ((equal template-type tpl-selection-type)
X (progn
X (tpl-insert-selection template)
X ) ; progn
X ) ; (equal template-type tpl-selection-type)
X ((equal template-type tpl-repetition-type)
X (progn
X (tpl-insert-repetition template)
X ) ; progn
X ) ; (equal template-type tpl-repetition-type)
X ((equal template-type tpl-function-type)
X (progn
X (tpl-insert-function template)
X ) ; progn
X ) ; (equal template-type tpl-function-type)
X ((equal template-type tpl-string-type)
X (progn
X (tpl-unscan template)
X ) ; progn
X ) ; (equal template-type tpl-string-type)
X ) ; cond
X ) ; progn
X ; Else report failure
X (progn
X (if (y-or-n-p "Cannot find template---look in a buffer? ")
X (progn
X (setq looking nil)
X (tpl-insert-string-from-buffer tpl-name display-string)
X ) ; progn
X ; else
X (if (y-or-n-p "Cannot find template---load a template file? ")
X (progn
X (save-some-buffers)
X (load-tpl-file)
X ) ; progn
X ; else
X (progn
X (setq looking nil)
X (error "Gave up looking for template.")
X ) ; progn
X ) ; if (y-or-n-p ...load...)
X ) ; if (y-or-n-p ...look...)
X ) ; progn
X ) ; if template
X ) ; while looking
X ) ; let
X ) ; defun tpl-insert-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-lexical-check (input)
X "Check INPUT for validity against lexical definition."
X ; Local Variables
X (let (result)
X ; Body
X (if (and (string-match tpl-lexical-pattern input)
X (equal (match-beginning 0) 0)
X (equal (match-end 0) (length input)))
X (setq result t)
X (setq result nil)
X ) ; if
X (if (not result)
X (progn
X (ding)
X (message (concat "String does not match pattern: "
X tpl-lexical-pattern))
X ) ; progn
X ) ; if
X ; return
X result
X ) ; let
X ) ; defun tpl-lexical-check
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-make-all-templates-template ()
X "Make a template consisting of a selection of all templates.
X Replace existing version if present."
X ; Local Variables
X (let (name template-tree template-file template-list file-name name-list
X new-template-list)
X ; Body
X (message "Rebuilding list of all templates...")
X ; Build name-list
X (setq template-list tpl-local-template-list)
X (setq new-template-list nil)
X (setq name-list nil)
X (while template-list
X (setq template-file (car template-list))
X (setq template-list (cdr template-list))
X (setq file-name (nth 0 template-file))
X ; Remove existing version if present
X (if (not (string-equal file-name tpl-all-templates-file))
X (progn
X (setq new-template-list
X (append new-template-list (list template-file)))
X (setq name-list
X (append name-list (nth 2 template-file)))
X ) ; progn
X ) ; if
X ) ; while template-list
X ; Build template
X (save-window-excursion
X (set-buffer tpl-work-buffer)
X (erase-buffer)
X (while name-list
X (setq name (car name-list))
X (setq name-list (cdr name-list))
X (insert (car name) ":")
X (newline)
X ) ; while name-list
X (shell-command-on-region (point-min) (point-max) "sort -u" t)
X ; Insert preface
X (goto-char (point-min))
X (insert tpl-begin-template-definition " "
X tpl-all-templates-name " "
X tpl-selection-type)
X (newline)
X (beginning-of-line 0)
X (delete-char 1) ; Remove regular exression anchor
X (end-of-line)
X (newline)
X (insert tpl-begin-template-body)
X (beginning-of-line)
X (delete-char 1) ; Remove regular exression anchor
X ; Insert suffix
X (goto-char (point-max))
X (insert tpl-end-template-body)
X (beginning-of-line)
X (delete-char 1)
X (end-of-line)
X (newline)
X ; Create template
X (goto-char (point-min))
X (setq template-tree (tpl-scan-template))
X ) ; save-window-excursion
X (bury-buffer tpl-work-buffer)
X ; Rebuild template-list
X (setq tpl-local-template-list
X (append (list (list tpl-all-templates-file
X (list template-tree) nil))
X new-template-list))
X (setq tpl-all-templates-template-invalid nil)
X (message "Rebuilding list of all templates...Done.")
X ) ; let
X ) ; defun tpl-make-all-templates-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-make-completion-list ()
X "Create a completion list of template names for prompting."
X ; Local Variables
X (let (name completion-list file-list template-file name-list)
X ; Body
X ; Build completion list
X (setq completion-list nil)
X (setq file-list tpl-local-template-list)
X (while file-list
X (setq template-file (car file-list))
X (setq file-list (cdr file-list))
X (setq name-list (nth 2 template-file))
X (setq completion-list (append completion-list name-list))
X ) ; while file-list
X ; return
X completion-list
X ) ; let
X ) ; defun tpl-make-completion-list
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-make-keymap ()
X "Make keymap for template-mode."
X ; Local Variables
X (let ()
X ; Body
X (setq tpl-saved-map (current-local-map))
X (if (not template-mode-map)
X (progn
X (setq template-mode-map tpl-saved-map)
X (define-key
X template-mode-map "\^c\^t\t" 'expand-symbol)
X (define-key
X template-mode-map "\^c\^ta" 'add-symbol)
X (define-key
X template-mode-map "\^c\^te" 'expand-placeholder)
X (define-key
X template-mode-map "\^c\^tg" 'query-replace-groups)
X (define-key
X template-mode-map "\^c\^tl" 'query-replace-lines)
X (define-key
X template-mode-map "\^c\^tr" 'replace-line-with-placeholder)
X (define-key
X template-mode-map "\^c\^tt" 'generate-template)
X (define-key
X template-mode-map "\^c\^tu" 'unwrap-template-around-point)
X (define-key
X template-mode-map "\^c\^tw" 'wrap-template-around-word)
X (define-key
X template-mode-map "\^c\^tW" 'wrap-template-around-line)
X (define-key
X template-mode-map "\^c\^t\^e" 'expand-placeholders-in-region)
X (define-key
X template-mode-map "\^c\^t\^h" 'describe-template-mode)
X (define-key
X template-mode-map "\^c\^t\^k" 'delete-placeholder)
X (define-key
X template-mode-map "\^c\^t\^n" 'next-placeholder)
X (define-key
X template-mode-map "\^c\^t\^p" 'previous-placeholder)
X (define-key
X template-mode-map "\^c\^t\^r" 'replace-region-with-placeholder)
X (define-key
X template-mode-map "\^c\^t\^u" 'rewrap-template-around-point)
X (define-key
X template-mode-map "\^c\^t\^w" 'wrap-template-around-region)
X (define-key
X template-mode-map "\^c\^t?" 'generate-any-template)
X ) ; progn
X ) ; if
X (use-local-map template-mode-map)
X ) ; let
X ) ; defun tpl-make-keymap
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-make-mode-entry (name file)
X "Constructor for mode entries from NAME FILE."
X ; Local Variables
X (let ()
X ; Body
X (list (list 'name name) (list 'file file))
X ) ; let
X ) ; defun tpl-make-mode-entry
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-make-placeholder-name ()
X "Create a name for a new template by searching for the first symbol
X after point."
X ; Local Variables
X (let ()
X ; Body
X (save-excursion
X (if (re-search-forward tpl-pattern-symbol nil t)
X (progn
X (setq tpl-formed-placeholder-name
X (buffer-substring (match-beginning 0) (match-end 0)))
X ) ; progn
X ; else
X (progn
X (setq tpl-formed-placeholder-name tpl-next-placeholder-name)
X (tpl-increment-next-placeholder-name)
X ) ; progn
X ) ; if
X ) ; save-excursion
X ) ; let
X ) ; defun tpl-make-placeholder-name
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-make-template-entry (name templates)
X "Constructor for mode entries from NAME TEMPLATES."
X ; Local Variables
X (let ()
X ; Body
X (list (list 'name name) (list 'templates templates))
X ) ; let
X ) ; defun tpl-make-template-entry
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-make-template-list (file &optional buffer)
X "Create a template list from the templates in FILE.
X Optional second argument non-nil means use a buffer, not a file."
X ; Local Variables
X (let (template-list template-tree template-name
X name-list msg table root-name)
X ; Body
X (setq msg (concat "Loading templates in " file ": "))
X (save-window-excursion
X (setq table (syntax-table))
X (set-buffer tpl-work-buffer)
X (erase-buffer)
X (if buffer
X (insert-buffer file)
X ; else
X (insert-file file)
X ) ;if buffer
X (set-syntax-table table)
X (goto-char (point-min))
X (setq name-list nil)
X (while (re-search-forward
X tpl-begin-template-definition (point-max) t)
X (beginning-of-line)
X (setq template-tree (tpl-scan-template))
X (setq template-list (append template-list (list template-tree)))
X (setq template-name (tpl-token-name template-tree))
X (message (concat msg template-name "..."))
X (if (not (equal tpl-lexical-type
X (tpl-token-type template-tree)))
X (setq name-list
X (append name-list (list (list template-name))))
X ) ; if
X ) ; while (re-search-forward...)
X (setq template-list
X (list (tpl-root-of-file-name (file-name-nondirectory file))
X template-list name-list))
X ) ; save-window-excursion
X (bury-buffer tpl-work-buffer)
X (message (concat msg "Done."))
X ; return
X template-list
X ) ; let
X ) ; defun tpl-make-template-list
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-mode-file (mode-entry)
X "Selector for file field of MODE-ENTRY."
X ; Local Variables
X (let ()
X ; Body
X (car (cdr (assq 'file mode-entry)))
X ) ; let
X ) ; defun tpl-mode-file
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-mode-match (mode-nm list)
X "Find mode-entry that matches MODE-NM in LIST."
X ; Local Variables
X (let (entry)
X ; Body
X (while list
X (setq entry (car list))
X (setq list (cdr list))
X (if (equal (tpl-mode-name entry) mode-nm)
X (setq list nil)
X ; else
X (setq entry nil)
X ) ; if
X ) ; while
X ; return
X entry
X ) ; let
X ) ; defun tpl-mode-match
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-mode-name (mode-entry)
X "Selector for name field of MODE-ENTRY."
X ; Local Variables
X (let ()
X ; Body
X (car (cdr (assq 'name mode-entry)))
X ) ; let
X ) ; defun tpl-mode-name
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-mode-templates (mode-entry)
X "Selector for templates field of MODE-ENTRY."
X ; Local Variables
X (let ()
X ; Body
X (car (cdr (assq 'templates mode-entry)))
X ) ; let
X ) ; defun tpl-mode-templates
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-parse-choice (line)
X "Break menu LINE into component parts: (string template) or (string nil)."
X ; Local Variables
X (let (string-part template-part end-string end-template)
X ; Body
X ; Line =
X ; "abc" is string "abc"
X ; "abc:" is template "abc"
X ; "abc:def" is template "def"
X ; ";" begins comment area
X (setq end-string (string-match tpl-pattern-symbol line))
X (setq string-part (substring line 0 (match-end 0)))
X (setq line (substring line (match-end 0)))
X (setq end-string (string-match "^\\(\\s \\)*:\\(\\s \\)*" line))
X (if end-string
X (progn
X (setq line (substring line (match-end 0)))
X (setq end-string (string-match
X (concat "^" tpl-pattern-symbol) line))
X (if end-string
X (setq template-part (substring line 0 (match-end 0)))
X ; else
X (setq template-part string-part)
X ) ; if end-template
X ) ; progn
X ; else
X (progn
X (setq template-part nil)
X ) ; progn
X ) ; if end-string
X (list string-part template-part)
X ) ; let
X ) ; defun tpl-parse-choice
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-rebuild-global-template-list (name templates)
X "Rebuild global template list, changing major mode NAME to
X include TEMPLATES."
X ; Local Variables
X (let (mode-list mode-item entry result)
X ; Body
X (setq result nil)
X (setq entry nil)
X (setq mode-list tpl-global-template-list)
X (while (and mode-list (not entry))
X (setq mode-item (car mode-list))
X (setq mode-list (cdr mode-list))
X (if (string-equal (tpl-mode-name mode-item) name)
X (setq entry mode-item)
X ; else
X (setq result (append result (list mode-item)))
X ) ; if (equal (tpl-mode-name mode-item) name)
X ) ; while mode-list
X (if (not entry)
X (progn
X (setq tpl-global-template-list
X (append result
X (list (tpl-make-template-entry name templates))))
X (message "Added templates for %s." name)
X ) ; progn
X ; else
X (if (or (not (tpl-mode-templates mode-item))
X (y-or-n-p "Replace existing templates for this mode? "))
X (progn
X (setq result
X (append result (list (tpl-make-template-entry name
X templates))))
X (setq result (append result mode-list))
X (setq tpl-global-template-list result)
X (message "Added templates for %s." name)
X ) ; progn
X ) ; if
X ) ; if
X ) ; let
X ) ; defun tpl-rebuild-global-template-list
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-replace-group (from to)
X "Replace current region with a temporary placeholder.
X Arguments FROM and TO are ignored. (They are only needed
X for compatibility with other replacement functions.)"
X ; Local Variables
X (let (name)
X ; Body
X (if tpl-get-placeholder-name-in-context
X (setq name nil)
X ; else
X (progn
X (setq name tpl-next-placeholder-name)
X (tpl-increment-next-placeholder-name)
X ) ; progn
X ) ; if tpl-get-placeholder-name-in-context
X (replace-region-with-placeholder (mark) (point) name
X "new.tpl" nil)
X ) ; let
X ) ; defun tpl-replace-group
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-replace-line (from to)
X "Replace current line with a temporary placeholder.
X Arguments FROM and TO are ignored. (They are only needed
X for compatibility with other replacement functions.)"
X ; Local Variables
X (let (name)
X ; Body
X (if tpl-get-placeholder-name-in-context
X (setq name nil)
X ; else
X (progn
X (setq name tpl-next-placeholder-name)
X (tpl-increment-next-placeholder-name)
X ) ; progn
X ) ; if tpl-get-placeholder-name-in-context
X (replace-line-with-placeholder 1 name "new.tpl" nil)
X ) ; let
X ) ; defun tpl-replace-line
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-root-of-file-name (file)
X "Find the root of FILE as a template file name."
X ; Local Variables
X (let (result)
X ; Body
X (cond
X ((and (> (length file) 7)
X (equal (substring file -7) "tpl.elc"))
X (setq result (substring file 0 -7))
X )
X ((and (> (length file) 6)
X (equal (substring file -6) "tpl.el"))
X (setq result (substring file 0 -6))
X )
X ((and (> (length file) 4)
X (equal (substring file -4) ".tpl"))
X (setq result (substring file 0 -4))
X )
X (t
X (setq result file)
X )
X ) ; cond
X ; return
X result
X ) ; let
X ) ; defun tpl-root-of-file-name
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-undo-keymap ()
X "Undo keymap for template-mode."
X ; Local Variables
X (let ()
X ; Body
X (use-local-map tpl-saved-map)
X ) ; let
X ) ; defun tpl-undo-keymap
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-unwrap-template (template &optional arg)
X "Find the enclosing TEMPLATE around point and replace it with
X whatever is matching the destination placeholder.
X Optional second argument non-nil causes mark to be placed
X at the beginning of the resulting region."
X ; Local Variables
X (let (origin wrapper-pair wrapper-begin wrapper-end indent-amount
X prefix another-wrapper-end start match-start
X match-stop-marker)
X ; Body
X (setq origin (point))
X (setq match-stop-marker (make-marker))
X (setq wrapper-pair (tpl-find-wrappers template))
X (setq wrapper-begin (nth 0 wrapper-pair))
X (setq wrapper-end (nth 1 wrapper-pair))
X (setq indent-amount (nth 2 wrapper-pair))
X (if (search-backward wrapper-begin (point-min) t)
X (progn
X (setq start (point))
X (search-forward wrapper-begin)
X (delete-region start (point))
X (setq match-start (point))
X ; Get prefix of line for another try
X ; at matching ending part.
X (beginning-of-line nil)
X (setq prefix (buffer-substring (point) match-start))
X (goto-char match-start)
X (setq another-wrapper-end (concat (substring wrapper-end 0 1)
X prefix
X (substring wrapper-end 1)))
X ) ; progn
X ; else
X (error "Enclosing template not found.")
X ) ; if
X (if (search-forward wrapper-end (point-max) t)
X (progn
X (setq start (point))
X (search-backward wrapper-end (point-min) t)
X (delete-region (point) start)
X (set-marker match-stop-marker (point))
X ) ; progn
X ; else
X ; This is a hack to fix indented
X ; matches.
X (if (search-forward another-wrapper-end (point-max) t)
X (progn
X (setq start (point))
X (search-backward another-wrapper-end (point-min) t)
X (delete-region (point) start)
X (set-marker match-stop-marker (point))
X (goto-char match-start)
X (delete-backward-char (length prefix))
X (setq match-start (- match-start (length prefix)))
X ) ; progn
X ; else
X (progn
X (goto-char origin)
X (error "End of enclosing template not found.")
X ) ; progn
X ) ; if ...another...
X ) ; if
X (goto-char match-start)
X (forward-line 1)
X (if (< (point) (marker-position match-stop-marker))
X (indent-rigidly (point) (marker-position match-stop-marker)
X (- 0 indent-amount))
X ) ; if
X (goto-char (marker-position match-stop-marker))
X (set-marker match-stop-marker nil)
X (if arg
X (push-mark match-start)
X ) ; if arg
X ) ; let
X ) ; defun tpl-unwrap-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-wrap-template (start stop template)
X "Replace the region between START and STOP with TEMPLATE,
X reinserting the replaced region at the destination placeholder.
X The region is indented rigidly at its insertion column."
X ; Local Variables
X (let (save-expand-option region start-column orig-column)
X ; Body
X (setq save-expand-option tpl-ask-expansion-depth)
X (setq tpl-ask-expansion-depth 0)
X (setq region (buffer-substring start stop))
X (delete-region start stop)
X (goto-char start)
X (setq orig-column (current-column))
X (unwind-protect ; Protect against nonexistent template
X (tpl-generate template)
X (setq start (point))
X (setq start-column (current-column))
X (insert region)
X (indent-rigidly start (point) (- start-column orig-column))
X (setq tpl-ask-expansion-depth save-expand-option)
X ) ; unwind-protect
X (message "Done.")
X ) ; let
X ) ; defun tpl-wrap-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-y-or-n-p (msg)
X "Display MSG and await positive ('y') or negative ('n') response.
X Differs from 'y-or-n-p' in that it leaves the cursor in the active
X window, rather than moving to the mode-line."
X ; Local Variables
X (let (answered prompt reply result)
X ; Body
X (setq answered nil)
X (setq prompt (concat msg "(y or n) "))
X (while (not answered)
X (message prompt)
X (setq reply (read-char))
X (cond
X ((char-equal reply ?y)
X (setq answered t)
X (setq result t)
X ) ; (char-equal reply ?y)
X ((char-equal reply ? )
X (setq answered t)
X (setq result t)
X ) ; (char-equal reply ? )
X ((char-equal reply ?n)
X (setq answered t)
X (setq result nil)
X ) ; (char-equal reply ?n)
X ((char-equal reply ?\177)
X (setq answered t)
X (setq result nil)
X ) ; (char-equal reply ?\177)
X (t
X (ding)
X (setq prompt (concat "Please respond 'y' or 'n'. "
X msg "(y or n) "))
X ) ; t
X ) ; cond
X ) ; while (not answered)
X ; return
X result
X ) ; let
X ) ; defun tpl-y-or-n-p
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X;;; end of tplhelper.el
SHAR_EOF
if test 45072 -ne "`wc -c < 'tplhelper.el'`"
then
echo shar: "error transmitting 'tplhelper.el'" '(should have been 45072 characters)'
fi
fi
exit 0
# End of shel.."..".