rsalz@uunet.UU.NET (Rich Salz) (10/06/87)
Submitted-by: "Mark A. Ardis" <maa@sei.cmu.edu>
Posting-number: Volume 11, Issue 94
Archive-name: templates/part04
#! /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:
# tplparse.el
# tplscan.el
export PATH; PATH=/bin:/usr/bin:$PATH
echo shar: "extracting 'tplparse.el'" '(35827 characters)'
if test -f 'tplparse.el'
then
echo shar: "will not over-write existing file 'tplparse.el'"
else
sed 's/^X//' << \SHAR_EOF > 'tplparse.el'
X;;; tplparse.el -- Parsing routines for template package
X;;; Copyright (C) 1987 Mark A. Ardis.
X
X(require 'tplvars)
X(require 'tplhelper)
X
X(provide 'tplparse)
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X;;; All global variables are in "tplvars"
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun looking-at-tpl ()
X "t if text after point matches specified template."
X (interactive)
X ; Local Variables
X (let (name-list tpl-name)
X ; Body
X (setq name-list (tpl-make-completion-list))
X (setq tpl-name (completing-read "looking-at-tpl: Template name? "
X name-list nil t nil))
X (tpl-looking-at tpl-name)
X ) ; let
X) ; defun looking-at-tpl
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun query-replace-tpl ()
X "Replace some instances of a template with corresponding instances
X of another."
X (interactive)
X ; Local Variables
X (let (name-list from to)
X ; Body
X (setq name-list (tpl-make-completion-list))
X (setq from (completing-read "query-replace-tpl: From? "
X name-list nil t nil))
X (setq to (completing-read (concat "query-replace-tpl: From " from " To? ")
X name-list nil t nil))
X (tpl-query-replace from to)
X ) ; let
X) ; defun query-replace-tpl
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun replace-tpl ()
X "Replace an instance of a template with a corresponding instance
X of another template."
X (interactive)
X ; Local Variables
X (let (name-list from to)
X ; Body
X (setq name-list (tpl-make-completion-list))
X (setq from (completing-read "replace-tpl: From? "
X name-list nil t nil))
X (setq to (completing-read (concat "replace-tpl: From " from " To? ")
X name-list nil t nil))
X (while (tpl-search-forward from (point-max) t)
X (exchange-point-and-mark)
X (tpl-replace from to)
X ) ; while
X ) ; let
X) ; defun replace-tpl
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun search-forward-tpl ()
X "Search forward from point for a template."
X (interactive)
X ; Local Variables
X (let (name-list tpl-name)
X ; Body
X (setq name-list (tpl-make-completion-list))
X (setq tpl-name (completing-read "search-forward-tpl: Name of template? "
X name-list nil t nil))
X (tpl-search-forward tpl-name)
X ) ; let
X) ; defun search-forward-tpl
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-delete-leading-whitespace (text-list)
X "Remove leading whitespace tokens from TEXT-LIST and return remaining list."
X ; Local Variables
X (let ()
X ; Body
X (while (and text-list (equal tpl-whitespace-type
X (tpl-token-name (car text-list))))
X (setq text-list (cdr text-list))
X ) ; while
X ; return
X text-list
X ) ; let
X ) ; defun tpl-delete-leading-whitespace
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-fix-match (tree old new)
X "Adjust indentation in TREE from OLD to NEW."
X ; Local Variables
X (let (result token-list token)
X ; Body
X (if (not new)
X (setq new old)
X ) ; if
X (setq result nil)
X (setq token-list (tpl-token-value tree))
X (while token-list
X (setq token (car token-list))
X (setq token-list (cdr token-list))
X ;(debug nil "token" token)
X (if (and (equal tpl-indentation-type (tpl-token-name token))
X (/= tpl-comment-level (tpl-token-value token)))
X (setq token (tpl-make-token (tpl-token-type token)
X (tpl-token-name token)
X (+ (- new old) (tpl-token-value token))))
X ) ; if
X (setq result (append result (list token)))
X ) ; while token-list
X ; return
X result
X ) ; let
X ) ; defun tpl-fix-match
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-get-match (placeholder tree indent)
X "Find match for PLACEHOLDER in TREE. Adjust matched value with INDENT."
X ; Local Variables
X (let (name match token token-type current-indent)
X ; Body
X (setq name (tpl-token-name (tpl-parse-placeholder (tpl-token-value placeholder))))
X (setq match nil)
X (while (and tree (not match))
X (setq token (car tree))
X (setq tree (cdr tree))
X (setq token-type (tpl-token-type token))
X ;(debug nil "token-type" token-type)
X (if (equal tpl-terminal-type token-type)
X (if (equal tpl-indentation-type (tpl-token-name token))
X (setq current-indent (tpl-token-value token))
X ) ; if (equal tpl-indentation-type (tpl-token-name token))
X ; else
X (if (equal name
X (tpl-token-name
X (tpl-parse-placeholder (tpl-token-name token))))
X (setq match (tpl-fix-match token indent current-indent))
X ) ; if (equal name...)
X ) ; if (equal tpl-terminal-type token-type)
X ) ; while (and tree (not match))
X ; return
X match
X ) ; let
X ) ; defun tpl-get-match
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-get-placeholder-end (placeholder tpl-name &optional occurrence)
X "Prompt user for end of PLACEHOLDER in TPL-NAME.
X Optional third argument OCCURRENCE specifies which
X occurrence of placeholder to find."
X ; Local Variables
X (let (template msg return stop size)
X ; Body
X (if (not occurrence)
X (setq occurrence 1)
X ) ; if
X ; Get value before changing buffer
X (setq template (tpl-find-template tpl-name))
X (save-window-excursion
X (delete-other-windows)
X (pop-to-buffer (get-buffer-create "*Template*"))
X (erase-buffer)
X (tpl-unscan template)
X ; Size the window
X (setq stop (point-max))
X (goto-char (point-min))
X (setq size (1+ (count-lines (point) stop)))
X (setq size (max size window-min-height))
X (if (< size (window-height))
X (shrink-window (- (window-height) size))
X ) ; if
X ; Find the placeholder
X (search-forward placeholder (point-max) t occurrence)
X (other-window 1)
X (setq msg (concat "In \"" tpl-name "\" looking for end of \""
X placeholder "\""))
X (setq return (tpl-get-position (point) (point-max) msg))
X ) ; save-window-excursion
X (bury-buffer "*Template*")
X return
X ) ; let
X) ; defun tpl-get-placeholder-end
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-get-position (start stop msg &optional start-pos narrow)
X "Prompt user for a location between START and STOP with MSG.
X Optional fourth argument START-POS may be used for initial
X placement of point. Fifth argument NARROW, if non-nil,
X narrows the region."
X ; Local Variables
X (let (looking was-modifiable)
X ; Body
X ; Check for valid region
X (if (< stop start)
X (error "tpl-get-position: Invalid region specification.")
X ) ; if
X ; Save current status
X (if (not start-pos)
X (setq start-pos start)
X ) ; if
X (save-restriction
X (if narrow
X (narrow-to-region start stop)
X ) ; if
X (setq was-modifiable (not buffer-read-only))
X (if was-modifiable
X (toggle-read-only)
X ) ; if was-modifiable
X (setq orig-buffer (current-buffer))
X ; Loop until acceptable answer
X (setq looking t)
X (while looking
X (goto-char start-pos)
X (message msg)
X ; Wait for user selection
X (recursive-edit)
X ; Check validity
X (if (or (not (equal orig-buffer (current-buffer)))
X (< (point) start)
X (> (point) stop))
X (progn
X (ding)
X (message "Selected position out of bounds.")
X (sit-for 2)
X (pop-to-buffer orig-buffer)
X (goto-char start-pos)
X ) ; progn
X ; else
X (setq looking nil)
X ) ; if
X ) ; while looking
X ; Restore original status
X (if was-modifiable
X (toggle-read-only)
X ) ; if was-modifiable
X (if narrow
X (widen)
X ) ; if narrow
X ) ; save-restriction
X (point) ; return
X ) ; let
X) ; defun tpl-get-position
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-leading-text (template)
X "Return literal text string at start of TEMPLATE (a name)."
X ; Local Variables
X (let (body start stop result)
X ; Body
X (setq body (tpl-find-template template))
X (if (not body)
X (error "Cannot find template.")
X ) ; if (not body)
X (get-buffer-create "*Work*")
X (save-window-excursion
X (set-buffer "*Work*")
X (erase-buffer)
X (tpl-unscan body)
X (goto-char (point-min))
X (setq start (point))
X (end-of-line nil)
X (setq stop (point))
X (goto-char start)
X (if (re-search-forward tpl-begin-placeholder stop start)
X (re-search-backward tpl-begin-placeholder)
X ) ; if
X (setq result (buffer-substring start (point)))
X ) ; save-window-excursion
X ; return
X result
X ) ; let
X ) ; defun tpl-leading-text
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-line-to-token (tree)
X "Convert TREE from line-format to token-format."
X ; Local Variables
X (let (line-list line token result type name)
X ; Body
X (setq result nil)
X (setq type (tpl-token-type tree))
X (setq name (tpl-token-name tree))
X (setq line-list (tpl-token-value tree))
X (while line-list
X (setq line (car line-list))
X (setq line-list (cdr line-list))
X (setq result
X (append result
X (list (tpl-make-token tpl-terminal-type
X tpl-indentation-type
X (tpl-line-indent line)))))
X (setq result (append result (tpl-line-tokens line)))
X (if line-list
X (setq result (append result (list tpl-newline-token)))
X ) ; if line-list
X ) ; while line-list
X (setq result (tpl-make-token type name result))
X ; return
X result
X ) ; let
X ) ; defun tpl-line-to-token
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-looking-at (name)
X "t if text after point matches template NAME"
X ; Local Variables
X (let (result)
X ; Body
X (setq result (tpl-match-template name))
X (if result
X t
X nil
X ) ; if
X ) ; let
X ) ; defun tpl-looking-at
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-match-function-template (template)
X "Match TEMPLATE and return t or nil."
X ; Local Variables
X (let ()
X ; Body
X (error "tpl-match-function-type: Cannot match function-type templates.")
X ) ; let
X ) ; defun tpl-match-function-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-match-lexical-template (template)
X "Match TEMPLATE and return t or nil."
X ; Local Variables
X (let ()
X ; Body
X (looking-at (tpl-token-value template))
X ) ; let
X ) ; defun tpl-match-lexical-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-match-line (pattern text)
X "Attempt to match the line described by PATTERN with TEXT. Return t or nil."
X ; Local Variables
X (let (pattern-list text-list next-pattern result success)
X ; Body
X (if (and text
X (= (tpl-line-indent pattern) (tpl-line-indent text)))
X (progn
X (setq success t)
X (setq pattern-list (tpl-line-tokens pattern))
X (setq text-list (tpl-line-tokens text))
X (while (and pattern-list success text-list)
X (setq next-pattern (car pattern-list))
X (setq pattern-list (cdr pattern-list))
X (setq result (tpl-match-token next-pattern text-list))
X (if result
X (setq text-list (cdr result))
X ; else
X (setq success nil)
X ) ; if result
X ) ; while pattern-list
X ) ; progn
X ; else
X (setq success nil)
X ) ; if (= (tpl-line-indent pattern) (tpl-line-indent text))
X ; return
X success
X ) ; let
X ) ; defun tpl-match-line
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-match-pattern (pattern-list scanner-patterns)
X "Attempt to match each line in PATTERN-LIST with text after point.
X Return a list of matches. Second argument SCANNER-PATTERNS
X specifies what type of lexical patterns to use when scanning."
X ; Local Variables
X (let (success tree this-pattern next-pattern this-match first-text next-text
X start-region start-col
X this-indent next-indent)
X ; Body
X (setq success t)
X (setq tree nil)
X ; Initialize scanner
X (setq start-region (point))
X (setq start-col (current-column))
X (setq this-indent 0)
X ; Get first "next text line"
X (back-to-indentation)
X (setq next-text (tpl-scan-line start-col scanner-patterns))
X (setq this-indent (tpl-line-indent next-text))
X (if (not (eobp))
X (forward-char)
X ) ; if
X ; For each line in pattern
X (while (and pattern-list success)
X ;(debug nil "top of pattern loop")
X ; Get next pattern line
X (setq this-pattern (car pattern-list))
X (setq pattern-list (cdr pattern-list))
X (if pattern-list
X (setq next-pattern (car pattern-list))
X ; else
X (setq next-pattern nil)
X ) ; if pattern-list
X (setq this-match nil)
X ; Get first text line
X (setq first-text next-text)
X ; Try to match lines
X (if (tpl-match-line this-pattern first-text)
X (progn
X (setq this-match (list first-text))
X (if next-pattern
X (progn
X (setq next-indent (tpl-line-indent next-pattern))
X ; Get next text line
X (back-to-indentation)
X (setq next-text (tpl-scan-line start-col scanner-patterns))
X (setq this-indent (tpl-line-indent next-text))
X (if (not (eobp))
X (forward-char)
X ) ; if
X ; Append until next match
X (while (and (not (eobp))
X (or (> this-indent next-indent)
X (equal (tpl-line-tokens next-text) nil)))
X ;(debug nil "appending in middle...")
X (setq this-match (append this-match (list next-text)))
X ; Get next text line
X (back-to-indentation)
X (setq next-text (tpl-scan-line start-col scanner-patterns))
X (setq this-indent (tpl-line-indent next-text))
X (if (not (eobp))
X (forward-char)
X ) ; if
X ) ; while
X ) ; progn
X ; else
X ; Append until no more indentation
X (progn
X (while (and (not (eobp))
X (or (> this-indent 0)
X (equal (tpl-line-tokens next-text) nil)))
X ;(debug nil "appending at end...")
X (setq this-match (append this-match (list next-text)))
X ; Get next text line
X (back-to-indentation)
X (setq this-col (current-column))
X (setq next-text (tpl-scan-line start-col scanner-patterns))
X (setq this-indent (tpl-line-indent next-text))
X (if (not (eobp))
X (forward-char)
X ) ; if
X ) ; while
X (if (> this-indent 0)
X (setq this-match (append this-match (list next-text)))
X (forward-line -1)
X ) ; if
X ) ; progn
X ) ; if next-pattern
X (setq tree (append tree (list (list this-pattern this-match))))
X ) ; progn
X ; else
X (setq success nil)
X ) ; if (tpl-match-line this-pattern first-text)
X ) ; while pattern-list
X ; Set point and mark
X (if success
X (progn
X (setq success tree)
X (set-mark start-region)
X (if (eobp)
X (end-of-line)
X ; else
X (end-of-line 0)
X ) ; if
X ) ; progn
X ; else
X (goto-char start-region)
X ) ; if success
X ; return
X success
X ) ; let
X ) ; defun tpl-match-pattern
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-match-repetition-template (template)
X "Match TEMPLATE and return t or nil."
X ; Local Variables
X (let ()
X ; Body
X (error
X "tpl-match-repetition-template: Cannot match repetition-type template.")
X ) ; let
X ) ; defun tpl-match-repetition-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-match-selection-template (template)
X "Match TEMPLATE and return tree or nil."
X ; Local Variables
X (let (result selection-list selection)
X ; Body
X (setq result nil)
X (setq selection-list (tpl-token-value template))
X (while (and selection-list (not result))
X (setq selection (car selection-list))
X (setq selection-list (cdr selection-list))
X (setq selection (tpl-token-value (car (tpl-line-tokens selection))))
X (setq result (tpl-match-template selection))
X ) ; while selection-list
X ; return
X result
X ) ; let
X ) ; defun tpl-match-selection-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-match-sequence-template (template)
X "Match TEMPLATE and return tree or nil."
X ; Local Variables
X (let (pattern-list result)
X ; Body
X (setq pattern-list (tpl-token-value template))
X (setq result (tpl-match-pattern pattern-list lex-patterns))
X (if result
X (setq result (tpl-make-token
X tpl-sequence-type (tpl-token-name template) result))
X ) ; if result
X ; return
X result
X ) ; let
X ) ; defun tpl-match-sequence-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-match-string-template (template)
X "Match TEMPLATE and return tree or nil."
X ; Local Variables
X (let (pattern-list result)
X ; Body
X (setq pattern-list (tpl-token-value template))
X (setq result (tpl-match-pattern pattern-list string-patterns))
X (if result
X (setq result (tpl-make-token
X tpl-sequence-type (tpl-token-name template) result))
X ) ; if result
X ; return
X result
X ) ; let
X ) ; defun tpl-match-string-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-match-template (name)
X "Match template NAME and return tree or nil."
X ; Local Variables
X (let (template template-type result)
X ; Body
X (setq template (tpl-find-template name))
X (setq template-type (tpl-token-type template))
X (cond
X ((equal template-type tpl-function-type)
X (setq result (tpl-match-function-template template))
X ) ; (equal template-type tpl-function-type)
X ((equal template-type tpl-lexical-type)
X (setq result (tpl-match-lexical-template template))
X ) ; (equal template-type tpl-lexical-type)
X ((equal template-type tpl-repetition-type)
X (setq result (tpl-match-repetition-template template))
X ) ; (equal template-type tpl-repetition-type)
X ((equal template-type tpl-selection-type)
X (setq result (tpl-match-selection-template template))
X ) ; (equal template-type tpl-selection-type)
X ((equal template-type tpl-sequence-type)
X (setq result (tpl-match-sequence-template template))
X ) ; (equal template-type tpl-sequence-type)
X ((equal template-type tpl-string-type)
X (setq result (tpl-match-string-template template))
X ) ; (equal template-type tpl-string-type)
X ) ; cond
X ; return
X result
X ) ; let
X ) ; defun tpl-match-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-match-token (token text-list)
X "Attempt to match TOKEN with tokens in TEXT-LIST. Return the
X list (t remainder-of-TEXT-LIST) or nil."
X ; Local Variables
X (let (type success)
X ; Body
X (setq text-list (tpl-delete-leading-whitespace text-list))
X (setq type (tpl-token-name token))
X (cond
X ((or (equal type tpl-other-type)
X (equal type tpl-punctuation-type)
X (equal type tpl-string-type))
X (progn
X (if text-list
X (progn
X (setq success (equal (tpl-token-value token)
X (tpl-token-value (car text-list))))
X (setq text-list (cdr text-list))
X ) ; progn
X ; else
X (setq success nil)
X ) ; if text-list
X ) ; progn
X ) ; (or (equal type tpl-other-type)...)
X ((equal type tpl-word-type)
X (progn
X (if text-list
X (progn
X (setq success (equal (upcase (tpl-token-value token))
X (upcase (tpl-token-value (car text-list)))))
X (setq text-list (cdr text-list))
X ) ; progn
X ; else
X (setq success nil)
X ) ; if text-list
X ) ; progn
X ) ; (equal type tpl-word-type)
X ((equal type tpl-whitespace-type)
X (progn
X (if (and text-list
X (equal tpl-whitespace-type (tpl-token-name (car text-list))))
X (setq text-list (cdr text-list))
X ) ; if
X (setq success t)
X ) ; progn
X ) ; (equal type tpl-whitespace-type)
X ((or (equal type tpl-placeholder-type)
X (equal type tpl-optional-type))
X (progn
X (setq text-list nil)
X (setq success t)
X ) ; progn
X ) ; (equal type tpl-placeholder-type)
X ) ; cond
X (if success
X (setq success (cons t text-list))
X ) ; if success
X ; return
X success
X ) ; let
X ) ; defun tpl-match-token
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-parse-function (template)
X "Try to parse text at point as an instance of function-type TEMPLATE.
X Return a parse tree or nil."
X ; Local Variables
X (let ()
X ; Body
X (error "tpl-parse-function: Cannot parse function-type templates.")
X ) ; let
X) ; defun tpl-parse-function
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-parse-instance (tpl-name)
X "Try to parse text at point as an instance of TPL-NAME.
X Return a parse tree or nil."
X ; Local Variables
X (let ()
X ; Body
X (setq template (tpl-find-template tpl-name))
X (setq template-type (tpl-token-type template))
X (cond
X ((equal template-type tpl-function-type)
X (setq result (tpl-parse-function template))
X ) ; (equal template-type tpl-function-type)
X ((equal template-type tpl-lexical-type)
X (setq result (tpl-parse-lexical template))
X ) ; (equal template-type tpl-lexical-type)
X ((equal template-type tpl-repetition-type)
X (setq result (tpl-parse-repetition template))
X ) ; (equal template-type tpl-repetition-type)
X ((equal template-type tpl-selection-type)
X (setq result (tpl-parse-selection template))
X ) ; (equal template-type tpl-selection-type)
X ((equal template-type tpl-sequence-type)
X (setq result (tpl-parse-sequence template))
X ) ; (equal template-type tpl-sequence-type)
X ((equal template-type tpl-string-type)
X (setq result (tpl-parse-string template))
X ) ; (equal template-type tpl-string-type)
X ) ; cond
X result ; return
X ) ; let
X) ; defun tpl-parse-instance
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-parse-lexical (template)
X "Try to parse text at point as an instance of lexical-type TEMPLATE.
X Return a parse tree or nil."
X ; Local Variables
X (let ()
X ; Body
X (error "tpl-parse-lexical: Cannot parse lexical-type templates.")
X ) ; let
X) ; defun tpl-parse-lexical
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-parse-pattern (pattern tpl-name start-col scanner-patterns)
X "Try to parse text at point as an instance of PATTERN within
X template TPL-NAME. START-COL specifies the starting column of
X the template. SCANNER-PATTERNS specifies which lexical patterns
X to use when scanning. Return a token or nil."
X ; Local Variables
X (let (type result start stop this-col indent-level)
X ; Body
X (setq type (tpl-token-name pattern))
X (cond
X ((equal type tpl-indentation-type)
X (progn
X (setq result pattern)
X ) ; progn
X ) ; (equal type tpl-indentation-type)
X ((equal type tpl-newline-type)
X (progn
X (setq result pattern)
X ) ; progn
X ) ; (equal type tpl-newline-type)
X ((equal type tpl-other-type)
X (progn
X (tpl-skip-over-whitespace)
X (if (looking-at (tpl-token-value pattern))
X (setq result (tpl-scan-token scanner-patterns))
X (setq result nil)
X ) ; if
X ) ; progn
X ) ; (equal type tpl-other-type)
X ((equal type tpl-placeholder-type)
X (progn
X (tpl-skip-over-whitespace)
X (setq start (point))
X (setq stop (tpl-get-placeholder-end (tpl-token-value pattern)
X tpl-name))
X (setq result nil)
X (goto-char start)
X (while (< (point) stop)
X (if (eolp)
X ; This code duplicates some of
X ; "tpl-scan-line"
X (progn
X (setq result
X (append result (list tpl-newline-token)))
X (forward-line 1)
X (back-to-indentation)
X (setq this-col (current-column))
X (cond
X ((>= this-col comment-column)
X (progn
X (setq indent-level tpl-comment-level)
X ) ; progn
X ) ; comment
X ((<= this-col start-col)
X (progn
X (setq indent-level 0)
X ) ; progn
X ) ; too small
X (t
X (progn
X (setq indent-level (- this-col start-col))
X ) ; progn
X ) ; t
X ) ; cond
X (setq result
X (append result (list (tpl-make-token
X tpl-terminal-type
X tpl-indentation-type
X indent-level))))
X ) ; progn
X ; else
X (progn
X (setq result
X (append result (list (tpl-scan-token scanner-patterns))))
X ) ; progn
X ) ; if
X ) ; while
X (setq result (tpl-make-token tpl-placeholder-type
X (tpl-token-value pattern)
X result))
X ) ; progn
X ) ; (equal type tpl-placeholder-type)
X ((equal type tpl-punctuation-type)
X (progn
X (tpl-skip-over-whitespace)
X (if (looking-at (tpl-token-value pattern))
X (setq result (tpl-scan-token scanner-patterns))
X (setq result nil)
X ) ; if
X ) ; progn
X ) ; (equal type tpl-punctuation-type)
X ((equal type tpl-string-type)
X (progn
X (tpl-skip-over-whitespace)
X (if (looking-at (tpl-token-value pattern))
X (setq result (tpl-scan-token scanner-patterns))
X (setq result nil)
X ) ; if
X ) ; progn
X ) ; (equal type tpl-string-type)
X ((equal type tpl-whitespace-type)
X (progn
X (setq result pattern)
X ) ; progn
X ) ; (equal type tpl-whitespace-type)
X ((equal type tpl-word-type)
X (progn
X (tpl-skip-over-whitespace)
X (if (looking-at (tpl-token-value pattern))
X (setq result (tpl-scan-token scanner-patterns))
X (setq result nil)
X ) ; if
X ) ; progn
X ) ; (equal type tpl-word-type)
X ) ; cond
X result ; return
X ) ; let
X) ; defun tpl-parse-pattern
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-parse-placeholder (string)
X "Parse STRING as a placeholder and return token."
X ; Local Variables
X (let (token)
X ; Body
X (get-buffer-create "*Work*")
X (save-window-excursion
X (set-buffer "*Work*")
X (erase-buffer)
X (insert string)
X (beginning-of-line)
X (setq token (tpl-scan-placeholder))
X ) ; save-window-excursion
X ; return
X token
X ) ; let
X ) ; defun tpl-parse-placeholder
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-parse-repetition (template)
X "Try to parse text at point as an instance of repetition-type TEMPLATE.
X Return a parse tree or nil."
X ; Local Variables
X (let ()
X ; Body
X (error "tpl-parse-repetition: Cannot parse repetition-type templates.")
X ) ; let
X) ; defun tpl-parse-repetition
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-parse-selection (template)
X "Try to parse text at point as an instance of selection-type TEMPLATE.
X Return a parse tree or nil."
X ; Local Variables
X (let ()
X ; Body
X (error "tpl-parse-selection: Cannot parse selection-type templates.")
X ) ; let
X) ; defun tpl-parse-selection
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-parse-sequence (template)
X "Try to parse text at point as an instance of sequence-type TEMPLATE.
X Return a parse tree or nil."
X ; Local Variables
X (let (tpl-name pattern-list pattern result success match start-col)
X ; Body
X (setq tpl-name (tpl-token-name template))
X (setq pattern-list (tpl-token-value (tpl-line-to-token template)))
X (setq start-col (current-column))
X (setq result nil)
X (setq success t)
X (while (and success pattern-list)
X (setq pattern (car pattern-list))
X (setq pattern-list (cdr pattern-list))
X (setq match (tpl-parse-pattern pattern tpl-name start-col lex-patterns))
X (if match
X (setq result (append result (list match)))
X ; else
X (setq success nil)
X ) ; if match
X ) ; while
X (if success
X result ; return
X ; else
X nil ; return
X ) ; if success
X ) ; let
X) ; defun tpl-parse-sequence
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-parse-string (template)
X "Try to parse text at point as an instance of string-type TEMPLATE.
X Return a parse tree or nil."
X ; Local Variables
X (let (tpl-name pattern-list pattern result success match start-col)
X ; Body
X (setq tpl-name (tpl-token-name template))
X (setq pattern-list (tpl-token-value (tpl-line-to-token template)))
X (setq start-col (current-column))
X (setq result nil)
X (setq success t)
X (while (and success pattern-list)
X (setq pattern (car pattern-list))
X (setq pattern-list (cdr pattern-list))
X (setq match (tpl-parse-pattern
X pattern tpl-name start-col string-patterns))
X (if match
X (setq result (append result (list match)))
X ; else
X (setq success nil)
X ) ; if match
X ) ; while
X (if success
X result ; return
X ; else
X nil ; return
X ) ; if success
X ) ; let
X) ; defun tpl-parse-string
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-query-replace (from to)
X "Replace some instances after point matching FROM template with
X corresponding instances of TO. As each match is found, the user
X must type a character saying what to do with it. For directions,
X type \\[help-command] at that time."
X ; Local Variables
X (let ()
X ; Body
X (perform-replace-tpl from to t nil nil
X 'tpl-search-forward
X 'exchange-point-and-mark 'tpl-replace)
X ) ; let
X ) ; defun tpl-query-replace
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-replace (from to)
X "Replace the instance of template FROM with a corresponding instance
X of template TO."
X ; Local Variables
X (let (token-tree new start)
X ; Body
X (setq start (point))
X (message (concat "replace-tpl: Trying to match \"" from "\"..."))
X (setq token-tree (tpl-parse-instance from))
X ;(debug nil "token-tree" token-tree)
X (message (concat "replace-tpl: Trying to construct \"" to "\"..."))
X (setq new (tpl-token-to-line (tpl-replace-placeholders to token-tree)))
X ;(debug nil "new tree" new)
X (delete-region start (point))
X (setq start (point))
X (tpl-unscan new)
X (set-mark start)
X (message "replace-tpl: Done.")
X ) ; let
X ) ; defun tpl-replace
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-replace-placeholders (name tree)
X "Replace placeholders in template NAME using values from TREE."
X ; Local Variables
X (let (result template token-list token token-type current-indent match)
X ; Body
X (setq result nil)
X (setq template (tpl-find-template name))
X (if (not (or
X (equal tpl-sequence-type (tpl-token-type template))
X (equal tpl-string-type (tpl-token-type template))))
X (error (concat "tpl-replace-placeholders: "
X "Target template must be SEQUENCE or STRING type"))
X ) ; if
X (setq token-list (tpl-token-value (tpl-line-to-token template)))
X (while token-list
X (setq token (car token-list))
X (setq token-list (cdr token-list))
X (setq token-type (tpl-token-name token))
X ;(debug nil "token-type" token-type)
X (if (or (equal tpl-placeholder-type token-type)
X (equal tpl-optional-type token-type))
X (progn
X (setq match (tpl-get-match token tree current-indent))
X (if match
X (setq result (append result match))
X ; else
X (setq result (append result (list token)))
X ) ; if match
X ) ; progn
X ; else
X (progn
X (if (equal tpl-indentation-type token-type)
X (setq current-indent (tpl-token-value token))
X ) ; if (equal tpl-indentation-type token-type)
X (setq result (append result (list token)))
X ) ; progn
X ) ; if (equal tpl-placeholder-type token-type)
X ) ; while token-list
X (setq result (tpl-make-token t t result))
X ; return
X result
X ) ; let
X ) ; defun tpl-replace-placeholders
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-search-forward (template &optional bound forgiving count)
X "Search forward from point for TEMPLATE (a name).
X An optional second argument bounds the search; it is a buffer
X position. The match found must not extend beyond that position.
X Optional third argument, if t, means if fail just return nil
X (no error). If not nil and not t, move to limit of search and
X return nil. Optional fourth argument is repeat count."
X ; Local Variables
X (let (leading found occur gaveup start trial)
X ; Body
X (setq start (point))
X (if (not bound)
X (setq bound (point-max))
X )
X (if (not count)
X (setq count 1)
X )
X (setq occur 0)
X (setq leading (tpl-leading-text template))
X (if leading
X (progn
X (setq found nil)
X (setq gaveup nil)
X (while (and (not found) (not gaveup))
X (if (search-forward leading bound t)
X (progn
X (search-backward leading)
X (setq trial (point))
X (setq found (tpl-looking-at template))
X (if (and found
X (<= (point) bound))
X (progn
X (setq occur (1+ occur))
X (if (< occur count)
X (setq found nil)
X )
X ) ; progn
X ; else
X (if found
X (setq gaveup t) ; Out of bounds---no more
X ; else
X (progn ; Failed this time---try again
X (goto-char trial)
X (forward-line 1)
X ) ; progn
X ) ; if found
X ) ; if (and found...)
X ) ; progn
X ; else
X (setq gaveup t)
X ) ; if (search-forward...)
X ) ; while
X ) ; progn
X ; else
X (error "Cannot search for templates that start with a placeholder.")
X ) ; if leading
X (if (or gaveup (not found))
X (if (not forgiving)
X (progn
X (goto-char bound)
X (error "Could not find template.")
X ) ; progn
X ; else
X (if (eq forgiving t)
X (progn
X (goto-char start)
X ) ; progn
X ; else
X (progn
X (goto-char bound)
X ) ; progn
X ) ; if (eq forgiving t)
X ) ; if (not forgiving)
X ) ; if (not found)
X (if gaveup
X (setq found nil)
X ) ; if gaveup
X ; return
X found
X ) ; let
X ) ; defun tpl-search-forward
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-skip-over-whitespace ()
X "Advance point past newlines and whitespace."
X ; Local Variables
X (let (moving)
X ; Body
X (setq moving t)
X (while (and moving (not (eobp)))
X (setq moving nil)
X (if (eolp)
X (progn
X (setq moving t)
X (forward-line 1)
X ) ; progn
X ) ; if
X (if (looking-at tpl-pattern-whitespace)
X (progn
X (setq moving t)
X (re-search-forward tpl-pattern-whitespace)
X ) ; progn
X ) ; if
X ) ; while
X ) ; let
X) ; defun tpl-skip-over-whitespace
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-token-to-line (tree)
X "Convert TREE from token-format to line-format."
X ; Local Variables
X (let (result line token-list token type name token-type save-indent)
X ; Body
X (setq result nil)
X (setq line nil)
X (setq type (tpl-token-type tree))
X (setq name (tpl-token-name tree))
X (setq token-list (tpl-token-value tree))
X (while token-list
X (setq token (car token-list))
X (setq token-list (cdr token-list))
X (setq token-type (tpl-token-name token))
X (cond
X ((equal token-type tpl-indentation-type)
X (progn
X (setq save-indent (tpl-token-value token))
X ) ; progn
X ) ; tpl-indentation-type
X ((equal token-type tpl-newline-type)
X (progn
X (setq result (append result (list (tpl-make-line save-indent line))))
X (setq line nil)
X ) ; progn
X ) ; tpl-newline-type
X (t
X (progn
X (setq line (append line (list token)))
X ) ; progn
X ) ; t
X ) ; cond
X ) ; while token-list
X (setq result (append result (list (tpl-make-line save-indent line))))
X (setq result (tpl-make-token type name result))
X ; return
X result
X ) ; let
X ) ; defun tpl-token-to-line
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X;;; end of tplparse.el
SHAR_EOF
if test 35827 -ne "`wc -c < 'tplparse.el'`"
then
echo shar: "error transmitting 'tplparse.el'" '(should have been 35827 characters)'
fi
fi
echo shar: "extracting 'tplscan.el'" '(12570 characters)'
if test -f 'tplscan.el'
then
echo shar: "will not over-write existing file 'tplscan.el'"
else
sed 's/^X//' << \SHAR_EOF > 'tplscan.el'
X;;; tplscan.el -- Scanner for template package
X;;; Copyright (C) 1987 Mark A. Ardis.
X
X(require 'tplvars)
X
X(provide 'tplscan)
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X;;; All global variables are in "tplvars".
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-make-pattern (pn pv)
X "Constructor for lexical patterns."
X (list (list 'name pn) (list 'value pv))
X ) ; defun tpl-make-pattern
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-pattern-name (p)
X "Selector for name field of lexical patterns."
X (car (cdr (assq 'name p)))
X ) ; defun tpl-pattern-name
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-pattern-value (p)
X "Selector for value field of lexical patterns."
X (car (cdr (assq 'value p)))
X ) ; defun tpl-pattern-value
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-make-token (tt tn tv)
X "Constructor for tokens."
X (list (list 'type tt) (list 'name tn) (list 'value tv))
X ) ; defun tpl-make-token
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-token-type (token)
X "Selector for type field of tokens."
X (car (cdr (assq 'type token)))
X ) ; defun tpl-token-type
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-token-name (token)
X "Selector for name field of tokens."
X (car (cdr (assq 'name token)))
X ) ; defun tpl-token-name
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-token-value (token)
X "Selector for value field of tokens."
X (car (cdr (assq 'value token)))
X ) ; defun tpl-token-value
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-make-line (indent-level token-list)
X "Constructor for lines."
X (list (list 'indent indent-level) (list 'tokens token-list))
X ) ; defun tpl-make-line
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-line-indent (line)
X "Selector for indentation field of lines."
X (car (cdr (assq 'indent line)))
X ) ; defun tpl-line-indent
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-line-tokens (line)
X "Selector for token-list field of lines."
X (car (cdr (assq 'tokens line)))
X ) ; defun tpl-line-tokens
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-scan-region (start stop pattern-list)
X "Scan the text between START and STOP using PATTERN-LIST for tokens.
X Return an indented line-list of tokens."
X ; Local Variables
X (let (start-col last-col this-col indent-level last-indent
X line line-list more)
X ; Body
X (goto-char start)
X (setq start-col (current-column))
X (setq line-list nil)
X (save-restriction
X (narrow-to-region start stop)
X (and (boundp 'template-scan-hook)
X template-scan-hook
X (funcall template-scan-hook))
X (if (eobp)
X (setq more nil)
X (setq more t)
X ) ; if (eobp)
X (while more
X ; Scan a line
X (back-to-indentation)
X (setq line (tpl-scan-line start-col pattern-list))
X (setq line-list (append line-list (list line)))
X ; Advance to next line
X (if (not (eobp))
X (forward-char)
X (setq more nil)
X ) ; if (not (eobp))
X ) ; while more
X ) ; save-restriction
X ; return
X line-list
X ) ; let
X ) ; defun tpl-scan-region
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-scan-line (start-col pattern-list)
X "Scan a line of text, returning an indentation-line of tokens.
X START-COL is the origin column for a region.
X PATTERN-LIST is the list of tokens to scan for."
X ; Local Variables
X (let (this-col indent-level line)
X ; Body
X (if tpl-literal-whitespace
X (progn
X (beginning-of-line nil)
X (setq line (tpl-make-line 0 (tpl-scan-token-list pattern-list)))
X ) ; progn
X ; else
X (progn
X (back-to-indentation)
X (setq this-col (current-column))
X (cond
X ((>= this-col comment-column)
X (progn
X (setq indent-level tpl-comment-level)
X ) ; progn
X ) ; comment
X ((<= this-col start-col)
X (progn
X (setq indent-level 0)
X ) ; progn
X ) ; too small
X (t
X (progn
X (setq indent-level (- this-col start-col))
X ) ; progn
X ) ; t
X ) ; cond
X ; Scan tokens and make into a line
X (setq line (tpl-make-line indent-level
X (tpl-scan-token-list pattern-list)))
X ) ; progn
X ) ; if tpl-literal-whitespace
X ; return
X line
X ) ; let
X ) ; defun tpl-scan-line
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-scan-token (pattern-list)
X "Scan the text at point and return a token.
X PATTERN-LIST is the list of tokens to scan for."
X ; Local Variables
X (let (pattern pn pv token found start)
X ; Body
X (setq found nil)
X (while (and pattern-list (not found))
X (setq pattern (car pattern-list))
X (setq pattern-list (cdr pattern-list))
X (setq pn (tpl-pattern-name pattern))
X (setq pv (tpl-pattern-value pattern))
X (if (looking-at pv)
X (setq found t)
X ) ; if (looking-at pattern)
X ) ; while (and pattern-list (not found))
X (if (not found)
X (error "Unable to scan text.")
X ) ; if (not found)
X (setq start (point))
X (re-search-forward pv)
X (setq token (tpl-make-token tpl-terminal-type pn
X (buffer-substring start (point))))
X token ; return
X ) ; let
X ) ; defun tpl-scan-token
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-scan-token-list (pattern-list)
X "Scan the current line and return a list of tokens.
X PATTERN-LIST is the list of tokens to scan for."
X ; Local Variables
X (let (save-list token token-list)
X ; Body
X (setq token-list nil)
X (setq save-list pattern-list)
X (while (not (eolp))
X (setq pattern-list save-list)
X (setq token (tpl-scan-token pattern-list))
X (setq token-list (append token-list (list token)))
X ) ; while (not (eolp))
X ; return
X token-list
X ) ; let
X ) ; defun tpl-scan-token-list
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-scan-template ()
X "Scan the template at point and return its tree value."
X ; Local Variables
X (let (start template-name template-type token-list tree save-patterns)
X ; Body
X (re-search-forward tpl-begin-template-definition)
X (re-search-forward tpl-pattern-whitespace)
X (setq start (point))
X (re-search-forward tpl-pattern-symbol)
X (setq template-name (buffer-substring start (point)))
X (re-search-forward tpl-pattern-whitespace)
X (setq start (point))
X (re-search-forward tpl-pattern-word)
X (setq template-type (buffer-substring start (point)))
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 (if (or (equal template-type tpl-lexical-type)
X (equal template-type tpl-function-type))
X (setq token-list (buffer-substring start (point)))
X ; else
X (if (equal template-type tpl-string-type)
X (setq token-list (tpl-scan-region start (point) string-patterns))
X ; else
X (setq token-list (tpl-scan-region start (point) lex-patterns))
X ) ; if (equal template-type tpl-string-type)
X ) ; if (or ...)
X (setq tree (tpl-make-token template-type template-name token-list))
X ; return
X tree
X ) ; let
X ) ; defun tpl-scan-template
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-scan-placeholder ()
X "Scan the placeholder at point and return its tree value."
X ; Local Variables
X (let (save start placeholder-type placeholder-name token-type)
X ; Body
X (setq save (point))
X (re-search-forward tpl-begin-placeholder)
X (if (looking-at tpl-pattern-optional)
X (progn
X (setq token-type tpl-optional-type)
X (re-search-forward tpl-pattern-optional)
X ) ; progn
X ; else
X (progn
X (setq token-type tpl-placeholder-type)
X ) ; progn
X ) ; if (looking-at tpl-pattern-optional)
X (setq start (point))
X (if (looking-at tpl-destination-symbol)
X (forward-char (length tpl-destination-symbol))
X (re-search-forward tpl-pattern-symbol)
X ) ; if
X (setq placeholder-type (buffer-substring start (point)))
X (if (looking-at tpl-sep-placeholder)
X (progn
X (re-search-forward tpl-sep-placeholder)
X (setq start (point))
X (re-search-forward tpl-pattern-symbol)
X (setq placeholder-name (buffer-substring start (point)))
X ) ; progn
X ; else
X (progn
X (setq placeholder-name nil)
X ) ; progn
X ) ; if (looking-at tpl-sep-placeholder)
X (setq placeholder (tpl-make-token
X token-type
X placeholder-type
X placeholder-name))
X (goto-char save)
X ; return
X placeholder
X ) ; let
X ) ; defun tpl-scan-placeholder
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-unscan (token &optional column)
X "Insert at point the values of tokens in the tree rooted by TOKEN.
X Optional second argument COLUMN specifies where to indent rigidly.
X Default is the current column."
X ; Local Variables
X (let (begin-template start-column token-list line-list line save-hook)
X ; Body
X ; Save auto-fill-hook and reset
X (setq save-hook auto-fill-hook)
X (if (not tpl-fill-while-unscanning)
X (setq auto-fill-hook nil)
X ) ; if
X ; Unscan template
X (setq begin-template (point))
X (if column
X (setq start-column column)
X ; else
X (setq start-column (current-column))
X ) ; if column
X (setq line-list (tpl-token-value token))
X (while line-list
X (setq line (car line-list))
X (setq line-list (cdr line-list))
X (if (= tpl-comment-level (tpl-line-indent line))
X (indent-to comment-column)
X ; else
X (indent-to (+ start-column (tpl-line-indent line)))
X ) ; if
X (setq token-list (tpl-line-tokens line))
X (while token-list
X (setq token (car token-list))
X (setq token-list (cdr token-list))
X ;(debug "tpl-unscan token:" token)
X (insert-before-markers (tpl-token-value token))
X ) ; while token-list
X (if line-list
X (newline)
X ) ; if line-list
X ) ; while line-list
X (if (and (boundp 'template-unscan-hook)
X template-unscan-hook)
X (funcall template-unscan-hook begin-template (point) start-column)
X ) ; if
X ; Reset auto-fill-hook
X (setq auto-fill-hook save-hook)
X ) ; let
X ) ; defun tpl-unscan
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-fix-syntax (string)
X "Change any syntax entries in STRING from (word or symbol or quote)
X to punctuation."
X ; Local Variables
X (let (char)
X ; Body
X (while (> (length string) 0)
X (setq char (string-to-char string))
X (setq string (substring string 1))
X (if (or (equal (char-syntax char) ? )
X (equal (char-syntax char) ?_)
X (equal (char-syntax char) ?'))
X (modify-syntax-entry char ". ")
X ) ; if
X ) ; while
X ) ; let
X ) ; defun tpl-fix-syntax
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X(defun tpl-initialize-scan ()
X "Initialize environment for scan."
X ; Local Variables
X (let ()
X ; Body
X ; Make all characters non-symbols
X (tpl-fix-syntax tpl-begin-placeholder)
X (tpl-fix-syntax tpl-end-placeholder)
X (tpl-fix-syntax tpl-sep-placeholder)
X (tpl-fix-syntax tpl-pattern-optional)
X ; Build composite patterns
X (setq tpl-begin-optional (concat tpl-begin-placeholder
X tpl-pattern-optional))
X (setq tpl-destination-placeholder (concat tpl-begin-placeholder
X tpl-destination-symbol
X tpl-end-placeholder))
X (setq tpl-pattern-placeholder (concat tpl-begin-placeholder
X "\\(" tpl-pattern-optional "\\)?"
X tpl-pattern-symbol
X "\\(" tpl-sep-placeholder
X tpl-pattern-symbol "\\)?"
X tpl-end-placeholder))
X ; Build lexical patterns
X (setq lex-patterns
X (list
X (tpl-make-pattern tpl-placeholder-type tpl-pattern-placeholder)
X (tpl-make-pattern tpl-whitespace-type tpl-pattern-whitespace)
X (tpl-make-pattern tpl-word-type tpl-pattern-word)
X (tpl-make-pattern tpl-punctuation-type tpl-pattern-punctuation)
X (tpl-make-pattern tpl-other-type tpl-pattern-other)
X ))
X (setq string-patterns
X (list
X (tpl-make-pattern tpl-string-type tpl-pattern-string)
X ))
X (setq tpl-newline-token
X (tpl-make-token tpl-terminal-type tpl-newline-type nil))
X ) ; let
X ) ; defun tpl-initialize-scan
X
X;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
X
X;;; end of tplscan.el
SHAR_EOF
if test 12570 -ne "`wc -c < 'tplscan.el'`"
then
echo shar: "error transmitting 'tplscan.el'" '(should have been 12570 characters)'
fi
fi
exit 0
# End of shell archive