home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / modes / templatemode / template.el < prev    next >
Encoding:
Text File  |  1992-08-08  |  26.3 KB  |  847 lines
  1. ;;; template.el -- generate and manipulate templates
  2. ;;; Copyright (C) 1987 Mark A. Ardis.
  3.  
  4. (require 'tplvars)
  5. (require 'menu)
  6. (require 'symbol)
  7. (require 'tplhelper)
  8. (require 'tplparse)
  9. (require 'tplreplace)
  10. (require 'tplscan)
  11.  
  12. (provide 'template)
  13.  
  14. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  15. ;;; All global variables are in "tplvars".
  16. ;;; All non-interactive helper functions are in "tplhelper" or "tplscan".
  17.  
  18. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  19.  
  20. (defun template-mode ()
  21.   "Toggle template-mode, a minor mode for manipulation of text via templates.
  22.     Calls 'template-mode-hook' if it is defined."
  23.   (interactive)
  24.                     ; Local Variables
  25.   (let (file-name)
  26.                     ; Body
  27.     (setq template-mode (not template-mode))
  28.     (set-buffer-modified-p (buffer-modified-p))
  29.     (if template-mode
  30.     (progn
  31.       (setq file-name (buffer-name))
  32.       (setq sym-completion-buffer (concat "id-" file-name))
  33.       (if tpl-save-identifier-file
  34.           (find-file-noselect sym-completion-buffer)
  35.         ; else
  36.         (get-buffer-create sym-completion-buffer)
  37.         ) ; if
  38.       (bury-buffer sym-completion-buffer)
  39.       (tpl-initialize-scan)
  40.       (tpl-build-template-list)
  41.       (tpl-make-keymap)
  42.       (and (boundp 'template-mode-hook)
  43.            template-mode-hook
  44.            (funcall template-mode-hook))
  45.       ) ; progn
  46.       ; else
  47.       (progn
  48.     (setq tpl-local-template-list nil)
  49.     (tpl-undo-keymap)
  50.     ) ; progn
  51.       ) ; if
  52.     ) ; let
  53.   ) ; defun template-mode
  54.  
  55. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  56.  
  57. (defun compile-templates (template-file)
  58.   "Compile the templates in TEMPLATE-FILE into a Lisp structure."
  59.   (interactive    "Fcompile-templates: Template file? ")
  60.                     ; Local Variables
  61.   (let (file-list file-name file
  62.           found root-name object-file)
  63.                     ; Body
  64.     (setq root-name (file-name-nondirectory template-file))
  65.     (if (and (> (length root-name) 4)
  66.          (equal (substring root-name -4) ".tpl"))
  67.     (setq root-name (substring root-name 0 -4))
  68.       ) ; if
  69.     (setq object-file (concat (file-name-directory template-file)
  70.                   root-name "tpl.el"))
  71.     (setq file-list tpl-local-template-list)
  72.     (setq found nil)
  73.     (while (and file-list (not found))
  74.       (setq file (car file-list))
  75.       (setq file-list (cdr file-list))
  76.       (setq file-name (nth 0 file))
  77.       (if (equal file-name root-name)
  78.       (setq found t)
  79.     ) ; if (equal file-name root-name)
  80.       ) ; while file-list
  81.     (if found
  82.     (progn
  83.       (save-window-excursion
  84.         (set-buffer tpl-work-buffer)
  85.         (erase-buffer)
  86.         (message "Compiling templates into a lisp form...")
  87.         (insert "(setq template-list '")
  88.         (insert (prin1-to-string file))
  89.         (insert ")")
  90.         (newline)
  91.         (write-region (point-min) (point-max) object-file)
  92.         (byte-compile-file object-file)
  93.         (delete-file object-file)
  94.         ) ; save-window-excursion
  95.       (bury-buffer tpl-work-buffer)
  96.       ) ; progn
  97.       ; else
  98.       (progn
  99.     (error "Cannot find " template-file)
  100.     ) ; progn
  101.       ) ; if found
  102.                     ; return
  103.     object-file
  104.     ) ; let
  105.   ) ; defun compile-templates
  106.  
  107. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  108.  
  109. (defun delete-placeholder ()
  110.   "Delete the placeholder at point."
  111.   (interactive)
  112.                     ; Local Variables
  113.   (let (start)
  114.                     ; Body
  115.     (if (looking-at tpl-pattern-placeholder)
  116.     (progn
  117.       (setq start (point))
  118.       (re-search-forward tpl-pattern-placeholder)
  119.       (delete-region start (point))
  120.       ) ; progn
  121.       ; else
  122.       (error "No placholder here!")
  123.       ) ; if (looking-at tpl-pattern-placeholder)
  124.     ) ; let
  125.   ) ; defun delete-placeholder
  126.  
  127. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  128.  
  129. (defun describe-template-mode ()
  130.   "Describe template-mode and its keybindings."
  131.   (interactive)
  132.                     ; Local Variables
  133.   (let (orig-buffer)
  134.                     ; Body
  135.     (setq orig-buffer (buffer-name))
  136.     (pop-to-buffer (get-buffer-create "*Help*"))
  137.     (erase-buffer)
  138.     (insert "Template-mode is a minor mode for manipulating regions of text\n")
  139.     (insert "called `templates'.  Templates have some of the attributes of\n")
  140.     (insert "productions in a context-free grammar.  They also have some of\n")
  141.     (insert "the attributes of rectangular pictures.  ")
  142.     (insert "For more information try:\n\n")
  143.     (insert "   C-h b  (describe-bindings)  Shows all of the new bindings.\n")
  144.     (insert "   C-h i  (info)  A user manual is available via `info'.\n")
  145.     (goto-char (point-min))
  146.     (pop-to-buffer orig-buffer)
  147.     ) ; let
  148.   ) ; defun describe-template-mode
  149.  
  150. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  151.  
  152. (defun expand-placeholder ()
  153.   "Expand the placeholder at point---interactive version."
  154.   (interactive)
  155.                     ; Local Variables
  156.   (let (start stop)
  157.                     ; Body
  158.     (if (looking-at tpl-pattern-placeholder)
  159.     (progn
  160.       (setq start (point))
  161.       (setq tpl-destination-needed t)
  162.       (tpl-expand-placeholder nil)
  163.       (setq stop (point))
  164.       (if (not tpl-destination-needed)
  165.           (progn
  166.         (goto-char (marker-position tpl-destination-marker))
  167.         (set-marker tpl-destination-marker nil)
  168.         ) ; progn
  169.         ; else
  170.         (progn
  171.           (setq tpl-destination-needed nil)
  172.           (goto-char start)
  173.           (if (re-search-forward tpl-pattern-placeholder stop stop)
  174.           (re-search-backward tpl-pattern-placeholder)
  175.         ) ; if
  176.           ) ; progn
  177.         ) ; if (not tpl-destination-needed)
  178.       ) ; progn
  179.       ; else
  180.       (error "expand-placeholder: No placeholder at point!")
  181.       ) ; if
  182.     ) ; let
  183.   ) ; defun expand-placeholder
  184.  
  185. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  186.  
  187. (defun expand-placeholders-in-region (start stop)
  188.   "Expand each placeholder in the region between START and STOP."
  189.   (interactive "r")
  190.                     ; Local Variables
  191.   (let (stop-marker save)
  192.                     ; Body
  193.     (goto-char start)
  194.     (setq stop-marker (make-marker))
  195.     (set-marker stop-marker stop)
  196.                     ; (The check for out-of-bounds is
  197.                     ;   needed for a placeholder at
  198.                     ;   the end of the region.)
  199.     (while (and (< (point) (marker-position stop-marker))
  200.         (re-search-forward
  201.          tpl-pattern-placeholder (marker-position stop-marker) t))
  202.       (re-search-backward tpl-pattern-placeholder)
  203.       (if (looking-at tpl-begin-optional)
  204.       (if (or (equal t tpl-keep-optional-placeholders)
  205.           (and tpl-keep-optional-placeholders
  206.                (tpl-y-or-n-p "Keep optional placeholder? ")))
  207.           (progn
  208.         (delete-char (length tpl-begin-optional))
  209.         (insert-before-markers tpl-begin-placeholder)
  210.         (re-search-backward tpl-begin-placeholder)
  211.         (if (or (< tpl-expansion-depth tpl-ask-expansion-depth)
  212.             (tpl-y-or-n-p "Expand? "))
  213.             (progn
  214.               (setq tpl-expansion-depth (1+ tpl-expansion-depth))
  215.               (unwind-protect
  216.               (tpl-expand-placeholder (marker-position stop-marker))
  217.             (setq tpl-expansion-depth (1- tpl-expansion-depth))
  218.             ) ; unwind-protect
  219.               ) ; progn
  220.           ; else
  221.           (progn
  222.             (re-search-forward tpl-pattern-placeholder)
  223.             ) ; progn
  224.           ) ; if (tpl-y-or-n-p "Expand? ")
  225.         ) ; progn
  226.         ; else
  227.         (progn
  228.           (setq save (point))
  229.           (re-search-forward tpl-pattern-placeholder)
  230.           (delete-region save (point))
  231.           (if (tpl-blank-line)
  232.           (delete-indentation)
  233.         ) ; if
  234.           ) ; progn
  235.         ) ; if (tpl-y-or-n-p "Keep optional placeholder? ")
  236.     ; else
  237.     (if (or (< tpl-expansion-depth tpl-ask-expansion-depth)
  238.         (tpl-y-or-n-p "Expand? "))
  239.         (progn
  240.           (setq tpl-expansion-depth (1+ tpl-expansion-depth))
  241.           (unwind-protect
  242.           (tpl-expand-placeholder (marker-position stop-marker))
  243.         (setq tpl-expansion-depth (1- tpl-expansion-depth))
  244.         ) ; unwind-protect
  245.           ) ; progn
  246.       ; else
  247.       (progn
  248.         (re-search-forward tpl-pattern-placeholder)
  249.         ) ; progn
  250.       ) ; if (tpl-y-or-n-p "Expand? ")
  251.     ) ; if (looking-at tpl-begin-optional)
  252.       ) ; while (re-search-forward...)
  253.     (if (< (point) (marker-position stop-marker))
  254.     (goto-char (marker-position stop-marker))
  255.       ) ; if
  256.     (set-marker stop-marker nil)
  257.     ) ; let
  258.   ) ; defun expand-placeholders-in-region
  259.  
  260. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  261.  
  262. (defun generate-any-template ()
  263.   "Generate any template, by using the special all-templates-template."
  264.   (interactive)
  265.                     ; Local Variables
  266.   (let ()
  267.                     ; Body
  268.     (if (or tpl-all-templates-template-invalid
  269.         (not (tpl-find-template tpl-all-templates-name)))
  270.     (if (y-or-n-p "Cannot find all-templates-template.  Rebuild? ")
  271.         (progn
  272.           (tpl-make-all-templates-template)
  273.           (tpl-generate tpl-all-templates-name)
  274.           ) ; progn
  275.       ; else
  276.       (error "Aborted.")
  277.       ) ; if (y-or-n-p ...)
  278.       ; else
  279.       (tpl-generate tpl-all-templates-name)
  280.       ) ; if
  281.     ) ; let
  282.   ) ; defun generate-any-template
  283.  
  284. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  285.  
  286. (defun generate-template ()
  287.   "Complete template name and call tpl-generate."
  288.   (interactive)
  289.                     ; Local Variables
  290.   (let (name name-list)
  291.                     ; Body
  292.                     ; Build completion list
  293.     (setq name-list (tpl-make-completion-list))
  294.     ; Query for name and generate
  295.     (setq name
  296.       (completing-read "generate-template: Name of template? "
  297.                name-list nil t nil))
  298.     (tpl-generate name)
  299.     ) ; let
  300.   ) ; defun generate-template
  301.  
  302. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  303.  
  304. (defun load-tpl-buffer (&optional buffer)
  305.   "Load all of the templates (in the optional BUFFER).
  306.     Defaults to 'tpl-new-template-buffer."
  307.   (interactive)
  308.                     ; Local Variables
  309.   (let (root-name new-list)
  310.                     ; Body
  311.     (if (not buffer)
  312.     (setq buffer
  313.           (read-buffer "load-tpl-buffer: Template buffer? "
  314.                tpl-new-template-buffer t))
  315.       ) ; if (not buffer)
  316.     (setq new-list (tpl-make-template-list buffer t))
  317.     (setq tpl-local-template-list (append (list new-list) tpl-local-template-list))
  318.     (if tpl-rebuild-all-templates-template
  319.     (tpl-make-all-templates-template)
  320.       ; else
  321.       (setq tpl-all-templates-template-invalid t)
  322.       ) ; if
  323.     (if (interactive-p)
  324.     (if (y-or-n-p "Rebuild global template list with these new templates? ")
  325.         (progn
  326.           (setq mode-nm (read-string "Mode name for global template list? "))
  327.           (tpl-rebuild-global-template-list mode-nm new-list)
  328.           ) ; progn
  329.       ) ; if (y-or-n-p ...)
  330.       ) ; if (interactive-p)
  331.     ) ; let
  332.   ) ; defun load-tpl-buffer
  333.  
  334. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  335.  
  336. (defun load-tpl-file (&optional file)
  337.   "Load all of the templates (in the optional FILE).
  338.     Uses file name completion in the current directory, and
  339.     defaults to 'tpl-new-template-buffer."
  340.   (interactive)
  341.                     ; Local Variables
  342.   (let (root-name new-list)
  343.                     ; Body
  344.     (if (not file)
  345.     (setq file
  346.           (expand-file-name (read-file-name
  347.                  (concat "load-tpl-file: Template file? ("
  348.                      tpl-new-template-buffer ") ")
  349.                  nil tpl-new-template-buffer)))
  350.       ) ; if (not file)
  351.     (setq root-name (tpl-root-of-file-name (file-name-nondirectory file)))
  352.     (setq new-list (tpl-make-template-list file))
  353.     (setq tpl-local-template-list (append (list new-list) tpl-local-template-list))
  354.     (if tpl-rebuild-all-templates-template
  355.     (tpl-make-all-templates-template)
  356.       ; else
  357.       (setq tpl-all-templates-template-invalid t)
  358.       ) ; if
  359.     (if (interactive-p)
  360.     (if (y-or-n-p "Rebuild global template list with these new templates? ")
  361.         (progn
  362.           (setq mode-nm (read-string "Mode name for global template list? "))
  363.           (tpl-rebuild-global-template-list mode-nm new-list)
  364.           ) ; progn
  365.       ) ; if (y-or-n-p ...)
  366.       ) ; if (interactive-p)
  367.     ) ; let
  368.   ) ; defun load-tpl-file
  369.  
  370. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  371.  
  372. (defun load-tpl-library (file &optional mode-nm)
  373.   "Find FILE and add all of the templates in it to the template list.
  374.     (Uses the 'tpl-load-path value to find the file.)  Optional second
  375.     argument MODE-NM is used to rebuild the global template list."
  376.   (interactive "sload-tpl-library: File name? ")
  377.                     ; Local Variables
  378.   (let (found head-template-list tail-template-list template-file file-name
  379.           root-name template-list new-list)
  380.                     ; Body
  381.     (setq root-name (tpl-root-of-file-name (file-name-nondirectory file)))
  382.                     ; Look for file in existing list
  383.     (setq found nil)
  384.     (setq head-template-list nil)
  385.     (setq tail-template-list tpl-local-template-list)
  386.     (while (and tail-template-list (not found))
  387.       (setq template-file (car tail-template-list))
  388.       (setq tail-template-list (cdr tail-template-list))
  389.       (setq file-name (nth 0 template-file))
  390.       (if (equal file-name root-name)
  391.       (setq found t)
  392.     ; else
  393.     (setq head-template-list
  394.           (append head-template-list (list template-file)))
  395.     ) ; if (equal file-name file)
  396.       ) ; while (and tail-template-list (not found))
  397.                     ; If found, query about replacing
  398.     (if (and found
  399.          (not (y-or-n-p "File already loaded.  Replace? ")))
  400.     (error "File already loaded.  Aborted.")
  401.       ) ; if
  402.     (setq tpl-local-template-list (append head-template-list tail-template-list))
  403.                     ; Find template file
  404.     (setq file (tpl-find-template-file root-name))
  405.     (if (and (> (length file) 4)
  406.          (equal (substring file -4) ".elc"))
  407.     (progn
  408.       (load file)
  409.       (setq new-list template-list)
  410.       ) ; progn
  411.       ; else
  412.       (progn
  413.     (setq new-list (tpl-make-template-list file))
  414.     ) ; progn
  415.       ) ; if compiled
  416.     (setq tpl-local-template-list
  417.       (append (list new-list)
  418.           tpl-local-template-list))
  419.     (if tpl-rebuild-all-templates-template
  420.     (tpl-make-all-templates-template)
  421.       ; else
  422.       (setq tpl-all-templates-template-invalid t)
  423.       ) ; if
  424.     (if (interactive-p)
  425.     (if (y-or-n-p "Rebuild global template list with these new templates? ")
  426.         (progn
  427.           (setq mode-nm
  428.             (read-minibuffer "Mode name for global template list? "))
  429.           (tpl-rebuild-global-template-list mode-nm new-list)
  430.           ) ; progn
  431.       ) ; if
  432.       ; else
  433.       (tpl-rebuild-global-template-list mode-nm new-list)
  434.       ) ; if
  435.     ) ; let
  436.   ) ; defun load-tpl-library
  437.  
  438. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  439.  
  440. (defun next-placeholder ()
  441.   "Search forward for the next placeholder."
  442.   (interactive)
  443.                     ; Local Variables
  444.   (let (count)
  445.                     ; Body
  446.     (if (looking-at tpl-pattern-placeholder)
  447.     (setq count 2)
  448.       ; else
  449.       (setq count 1)
  450.       ) ; if (looking-at tpl-pattern-placeholder)
  451.     (re-search-forward tpl-pattern-placeholder (point-max) nil count)
  452.     (re-search-backward tpl-pattern-placeholder)
  453.     ) ; let
  454.   ) ; defun next-placeholder
  455.  
  456. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  457.  
  458. (defun previous-placeholder ()
  459.   "Search backward for the previous placeholder."
  460.   (interactive)
  461.                     ; Local Variables
  462.   (let ()
  463.                     ; Body
  464.     (re-search-backward tpl-pattern-placeholder)
  465.     ) ; let
  466.   ) ; defun previous-placeholder
  467.  
  468. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  469.  
  470. (defun query-replace-groups (start stop)
  471.   "Replace some lines after point, beginning with a line that
  472.     matches START, and ending before a line that matches STOP, with
  473.     temporary placeholders.  As each match is found, the user
  474.     must type a character saying what to do with it.  For directions,
  475.     type \\[help-command] at that time."
  476.   (interactive "squery-replace-groups starting with: \nsquery-replace-groups starting with %s ending with: ")
  477.                     ; Local Variables
  478.   (let ()
  479.                     ; Body
  480.     (setq tpl-end-group (concat "^" stop))
  481.     (perform-replace-tpl
  482.      (concat "^" start)
  483.      "placeholder" t nil nil
  484.      're-search-forward 'tpl-find-end-of-group 'tpl-replace-group
  485.      'tpl-find-next-group)
  486.     ) ; let
  487.   ) ; defun query-replace-groups
  488.  
  489. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  490.  
  491. (defun query-replace-lines (string)
  492.   "Replace some lines after point matching leading STRING with
  493.     temporary placeholders.  As each match is found, the user
  494.     must type a character saying what to do with it.  For directions,
  495.     type \\[help-command] at that time."
  496.   (interactive "squery-replace-lines with leading pattern: ")
  497.                     ; Local Variables
  498.   (let ()
  499.                     ; Body
  500.     (perform-replace-tpl
  501.      (concat "^" string)
  502.      "placeholder" t nil nil
  503.      're-search-forward 'beginning-of-line 'tpl-replace-line)
  504.     ) ; let
  505.   ) ; defun query-replace-lines
  506.  
  507. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  508.  
  509. (defun region-to-tpl (start stop &optional name file parse)
  510.   "Create a template with the text between START and STOP.
  511.     Optionally, call it NAME and put the template in FILE.
  512.     Optional fifth argument PARSE specifies whether the template
  513.     should be parsed: if t parse, if nil do not parse, if neither
  514.     t nor nil ask about parsing."
  515.   (interactive "r")
  516.                     ; Local Variables
  517.   (let (string column text-file template table parse name-place
  518.            suggestion begin-body)
  519.                     ; Body
  520.     (if (not file)
  521.     (setq file
  522.           (expand-file-name (read-file-name
  523.                  (concat "Template file? ("
  524.                      tpl-new-template-buffer ") ")
  525.                  nil tpl-new-template-buffer)))
  526.       ) ; if (not file)
  527.     (if (and parse (not (equal parse t)))
  528.     (setq parse (y-or-n-p "region-to-tpl: Parse the template? "))
  529.       ) ; if
  530.     (setq string (buffer-substring start stop))
  531.     (goto-char start)
  532.     (setq column (current-column))
  533.     (goto-char stop)
  534.     (setq text-file (buffer-file-name))
  535.     (if (not (equal file text-file))
  536.     (progn
  537.       (find-file-other-window file)
  538.       (goto-char (point-min))
  539.       (open-line 1)
  540.       (insert tpl-begin-template-definition " ")
  541.       (setq name-place (point))
  542.       (insert " ")
  543.       (if parse
  544.           (insert tpl-sequence-type)
  545.         (insert tpl-string-type)
  546.         ) ; if parse
  547.       (beginning-of-line nil)
  548.       (delete-char 1)        ; Remove regexp anchor
  549.       (setq name-place (1- name-place))
  550.       (end-of-line nil)
  551.       (newline)
  552.       (insert tpl-begin-template-body)
  553.       (newline)
  554.       (beginning-of-line 0)
  555.       (delete-char 1)        ; Remove regexp anchor
  556.       (beginning-of-line 2)
  557.                     ; Insert body of template
  558.       (setq begin-body (point))
  559.       (insert string)
  560.       (newline)
  561.                     ; Fix indentation
  562.       (indent-rigidly begin-body (point) (- 0 column))
  563.       (insert tpl-end-template-body)
  564.       (newline)
  565.       (beginning-of-line 0)
  566.       (delete-char 1)        ; Remove regexp anchor
  567.       (goto-char name-place)
  568.       (if (not name)
  569.           (if tpl-get-placeholder-name-in-context
  570.           (progn
  571.             (if tpl-form-placeholder-name-from-context
  572.             (setq suggestion tpl-formed-placeholder-name)
  573.               ; else
  574.               (progn
  575.             (setq suggestion tpl-next-placeholder-name)
  576.             (tpl-increment-next-placeholder-name)
  577.             ) ; progn
  578.               ) ; if tpl-form-placeholder-name-from-context
  579.             (insert suggestion)
  580.             (if tpl-query-flag
  581.             (progn
  582.               (search-backward suggestion)
  583.               (setq name
  584.                 (sym-read-string "Placeholder name? "
  585.                          suggestion))
  586.               (if (equal (length name) 0)
  587.                   (progn
  588.                 (setq name suggestion)
  589.                 ) ; progn
  590.                 ) ; if
  591.               ) ; progn
  592.               ; else
  593.               (setq name suggestion)
  594.               ) ; if tpl-query-flag
  595.             ) ; progn
  596.         ; else
  597.         (progn
  598.           (setq name (tpl-get-placeholder-name))
  599.           (insert name)
  600.           ) ; progn
  601.         ) ; if tpl-get-placeholder-name-in-context
  602.         ; else
  603.         (insert name)
  604.         ) ; if (not-name)
  605.       ) ; progn
  606.       ; else
  607.       (error "Cannot reuse this file for templates!")
  608.       ) ; if (not (equal file text-file))
  609.                     ; return
  610.     name
  611.     ) ; let
  612.   ) ; defun region-to-tpl
  613.  
  614. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  615.  
  616. (defun replace-line-with-placeholder (count &optional name file parse)
  617.   "Replace the line containing point with a placeholder.
  618.     Prefix argument COUNT gives number of lines
  619.     (ending with current line).  Optional second argument NAME is used
  620.     for placeholder name.  Optional third argument FILE is used for
  621.     file to store template.  Optional fourth argument PARSE
  622.     specifies whether template should be parsed.  (See 'region-to-tpl
  623.     for interpretation.)"
  624.   (interactive "p")
  625.                     ; Local Variables
  626.   (let (start)
  627.                     ; Body
  628.     (if (interactive-p)
  629.     (progn
  630.       (setq parse "ask")
  631.       (setq file "new.tpl")
  632.       ) ; progn
  633.       ) ; if
  634.     (setq count (1- count))
  635.     (forward-line (* count -1))
  636.     (setq start (point))
  637.     (forward-line count)
  638.     (end-of-line nil)
  639.     (replace-region-with-placeholder start (point) name file parse)
  640.     ) ; let
  641.   ) ; defun replace-line-with-placeholder
  642.  
  643. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  644.  
  645. (defun replace-region-with-placeholder (start stop &optional name file parse)
  646.   "Replace the region between START and STOP with a placeholder.
  647.     Optionally, call it NAME and put the template in FILE.
  648.     Optional fifth argument PARSE specifies whether template
  649.     should be parsed.  (See 'region-to-tpl for interpretation.)"
  650.   (interactive "r")
  651.                     ; Local Variables
  652.   (let (start-marker stop-marker)
  653.                     ; Body
  654.     (if (interactive-p)
  655.     (progn
  656.       (setq parse "ask")
  657.       (setq file "new.tpl")
  658.       ) ; progn
  659.       ) ; if
  660.     (if (> (- stop start) 0)
  661.     (progn
  662.       (save-window-excursion
  663.         (setq start-marker (make-marker))
  664.         (set-marker start-marker start)
  665.         (setq stop-marker (make-marker))
  666.         (set-marker stop-marker stop)
  667.         (setq name (region-to-tpl start stop name file parse))
  668.         (if tpl-auto-save-new-templates
  669.         (save-buffer)
  670.           ) ; if tpl-auto-save-new-templates
  671.         ) ; save-window-excursion
  672.       (delete-region (marker-position start-marker)
  673.              (marker-position stop-marker))
  674.       (unwind-protect
  675.           (if tpl-auto-load-new-templates
  676.           (load-tpl-buffer (buffer-name (get-file-buffer file)))
  677.         ) ; if
  678.         (goto-char (marker-position start-marker))
  679.         (set-marker start-marker nil)
  680.         (set-marker stop-marker nil)
  681.         (insert-before-markers
  682.          tpl-begin-placeholder name tpl-end-placeholder))
  683.       ) ; progn
  684.       ; else
  685.       (insert-before-markers
  686.        tpl-begin-placeholder name tpl-end-placeholder)
  687.       ) ; if (> (- stop start) 0)
  688.     ) ; let
  689.   ) ; defun replace-region-with-placeholder
  690.  
  691. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  692.  
  693. (defun rewrap-template-around-point ()
  694.   "Unwrap FIRST template around point and wrap with SECOND.
  695.     Template names are prompted for with completing-read.
  696.     A side effect of this function is to push-mark at the beginning of the
  697.     enclosed region."
  698.   (interactive)
  699.                     ; Local Variables
  700.   (let (name-list first second)
  701.                     ; Body
  702.                     ; Build completion list
  703.     (setq name-list (tpl-make-completion-list))
  704.                     ; Query for name to unwrap
  705.     (setq first
  706.       (completing-read "rewrap-template: Name of enclosing template? "
  707.                name-list nil t nil))
  708.                     ; Query for name to wrap
  709.     (setq second
  710.       (completing-read "rewrap-template: Name of new template? "
  711.                name-list nil t nil))
  712.     (tpl-unwrap-template first t)
  713.     (tpl-wrap-template (mark) (point) second)
  714.     ) ; let
  715.   ) ; defun rewrap-template-around-point
  716.  
  717. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  718.  
  719. (defun tpl-recompile-templates (template-dir)
  720.   "Compile a standard list of templates in TEMPLATE-DIR."
  721.   (interactive "Dtpl-recompile-templates: Template directory? ")
  722.                     ; Local Variables
  723.   (let (prefix)
  724.                     ; Body
  725.     (autoload 'awk-mode "awk")
  726.     (autoload 'bib-mode "bib")
  727.     (autoload 'pascal-mode "pascal")
  728.     (setq prefix template-dir)
  729.     (if (not (equal (substring prefix -1) "/"))
  730.     (setq prefix (concat prefix "/"))
  731.       ) ; if
  732.     (if (not template-mode)
  733.     (template-mode)
  734.       ) ; if
  735.     (compile-templates (concat prefix "generic.tpl"))
  736.     (awk-mode)
  737.     (template-mode)
  738.     (compile-templates (concat prefix "awk.tpl"))
  739.     (bib-mode)
  740.     (template-mode)
  741.     (compile-templates (concat prefix "bib.tpl"))
  742.     (c-mode)
  743.     (template-mode)
  744.     (compile-templates (concat prefix "c.tpl"))
  745.     (emacs-lisp-mode)
  746.     (template-mode)
  747.     (compile-templates (concat prefix "elisp.tpl"))
  748.     (latex-mode)
  749.     (template-mode)
  750.     (compile-templates (concat prefix "latex.tpl"))
  751.     (pascal-mode)
  752.     (template-mode)
  753.     (compile-templates (concat prefix "pascal.tpl"))
  754.     (scribe-mode)
  755.     (template-mode)
  756.     (compile-templates (concat prefix "scribe.tpl"))
  757.     (texinfo-mode)
  758.     (template-mode)
  759.     (compile-templates (concat prefix "texinfo.tpl"))
  760.   ) ; let
  761. ) ; defun tpl-recompile-templates
  762.  
  763. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  764.  
  765. (defun unwrap-template-around-point (arg)
  766.   "Complete template name and call tpl-unwrap-template.  Prefix argument
  767.     ARG non-nil causes the mark to be set at the beginning of the resulting
  768.     region."
  769.   (interactive "P")
  770.                     ; Local Variables
  771.   (let (name name-list)
  772.                     ; Body
  773.                     ; Build completion list
  774.     (setq name-list (tpl-make-completion-list))
  775.                     ; Query for name and unwrap
  776.     (setq name
  777.       (completing-read "unwrap-template-around-point: Name of template? "
  778.                name-list nil t nil))
  779.     (tpl-unwrap-template name arg)
  780.     ) ; let
  781.   ) ; defun unwrap-template-around-point
  782.  
  783. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  784.  
  785. (defun wrap-template-around-line (count)
  786.   "Replace COUNT lines including point with TEMPLATE,
  787.     reinserting the replaced line at the destination placeholder.
  788.     Prefix argument indicates number of lines to wrap.
  789.     Second argument, TEMPLATE, is read with completing-read."
  790.   (interactive "p")
  791.                     ; Local Variables
  792.   (let (start)
  793.                     ; Body
  794.     (setq count (1- count))
  795.     (forward-line (* count -1))
  796.     (beginning-of-line nil)
  797.     (setq start (point))
  798.     (forward-line count)
  799.     (end-of-line nil)
  800.     (wrap-template-around-region start (point))
  801.     ) ; let
  802.   ) ; defun wrap-template-around-line
  803.  
  804. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  805.  
  806. (defun wrap-template-around-region (start stop)
  807.   "Replace the region between START and STOP with TEMPLATE,
  808.     reinserting the replaced region at the destination placeholder.
  809.     The region is indented rigidly at its insertion column.
  810.     The third argument, TEMPLATE, is read with completing-read."
  811.   (interactive "r")
  812.                     ; Local Variables
  813.   (let (name-list template)
  814.                     ; Body
  815.     (setq name-list (tpl-make-completion-list))
  816.     (setq template (completing-read "wrap-template: Name of template? "
  817.                     name-list nil t nil))
  818.     (tpl-wrap-template start stop template)
  819.     ) ; let
  820.   ) ; defun wrap-template-around-region
  821.  
  822. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  823.  
  824. (defun wrap-template-around-word (count)
  825.   "Replace COUNT words before point with TEMPLATE,
  826.     reinserting the replaced word at the destination placeholder.
  827.     Prefix argument indicates number of words to wrap.
  828.     Second argument, TEMPLATE, is read with completing-read."
  829.   (interactive "p")
  830.                     ; Local Variables
  831.   (let (start)
  832.                     ; Body
  833.     (forward-word (* count -1))
  834.     (setq start (point))
  835.     (forward-word count)
  836.     (wrap-template-around-region start (point))
  837.     ) ; let
  838.   ) ; defun wrap-template-around-word
  839.  
  840. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  841.  
  842. (tpl-initialize-modes)
  843.  
  844. ;;;+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
  845.  
  846. ;;; end of template.el
  847.