home *** CD-ROM | disk | FTP | other *** search
/ InfoMagic Source Code 1993 July / THE_SOURCE_CODE_CD_ROM.iso / languages / elisp / misc / auto-template.el < prev    next >
Encoding:
Text File  |  1992-11-25  |  5.6 KB  |  164 lines
  1. ; Path: hal.com!olivea!uunet!pipex!demon!edscom!kevin
  2. ; From: kevin@edscom.demon.co.uk (Kevin Broadey)
  3. ; Newsgroups: gnu.emacs.sources
  4. ; Subject: Automatic templates based on file suffix
  5. ; Date: 18 Nov 92 16:49:39 GMT
  6. ; Organization: EDS-Scicon, Milton Keynes, UK
  7. ; 
  8. ; I got hold of a copy of template.el by Tom Lord <lord+@andrew.cmu.edu> a
  9. ; while ago and quite liked it, especially the idea of a "substitutions
  10. ; file" which lets you specify on-the-fly replacements for macros in the
  11. ; included template file.
  12. ; 
  13. ; One way I used it a lot was to include a skeleton file whenever I
  14. ; started editing a new file, so I decided to modify it to run from
  15. ; `find-file-hooks', using the file extension to select the template file.
  16. ; I also tidied things up so that inclusion of a template could be undone
  17. ; with a single "undo" command.
  18. ; 
  19. ; Here it is - hope you like it.
  20. ; 
  21. ; Kevin
  22. ; 
  23. ; ------------------------------------------------------------------------
  24. ;; auto-template.el
  25. ;;
  26. ;; LCD Archive Entry:
  27. ;; auto-template|Kevin Broadey|kevin@edscom.demon.co.uk|
  28. ;; Auto insert templates with macro replacement based on file extension.|
  29. ;; 92-11-02|1.0|~/misc/auto-template.el.Z|
  30. ;;
  31. ;; Written by Kevin Broadey <kbroadey@edscom.demon.co.uk>
  32. ;;
  33. ;; Version 1.0  02-Nov-92
  34. ;;
  35. ;; Read the DOC string for usage information.
  36. ;;
  37. ;; Based on template.el by Tom Lord <lord+@andrew.cmu.edu>.  I added the stuff
  38. ;; for running from find-file-hooks and generally hacked it beyond all
  39. ;; recognition.
  40. ;;
  41. ;; Usual GNU copyleft stuff.
  42. ;;
  43. ;; Mail me with bug reports and suggestions.
  44.  
  45. ;; Mail me anyway if you like the package so I can feel all warm inside.
  46.  
  47. (defvar auto-template-dir "~/templates/"
  48.   "*Directory containing template files.")
  49.  
  50. (defun auto-template (&optional template-file)
  51.  
  52.   "Insert the contents of TEMPLATE-FILE after point.  Mark is set at the
  53. end of the inserted text.  If a \"substitutions file\" exists and is
  54. readable, the substitutions are applied to the inserted text.  The
  55. default directory for TEMPLATE-FILE is `auto-template-dir'.
  56.  
  57. A substitutions file has the same base name as TEMPLATE-FILE and suffix
  58. \".sub\".  Each line looks like:-
  59.  
  60.     \"@PLACE-HOLDER@\"      (string-valued-sexp)
  61. or
  62.     \"@PLACE-HOLDER@\"      \"Prompt: \"
  63.  
  64. In the first case @PLACE_HOLDER@ is replaced by the value of the sexp,
  65. and in the second the string is used as a prompt to read a replacement
  66. string from the minibuffer.
  67.  
  68. The format of the place-holder is entirely up to you.  Just remember to
  69. choose something that it unlikely to appear for real in the template
  70. file.  Also, because substitutions are performed in the order they
  71. appear, if the replacement for an earlier place-holder contains a later
  72. one, this too will be replaced.  This is a feature, not a bug!
  73.  
  74. If you add this function to your `find-file-hooks' then when you visit a
  75. new file it will automatically insert template file \"SUF.SUF\" from
  76. `auto-template-dir', where SUF is the suffix for the new file.  It will
  77. also apply substitutions file \"SUF.sub\" to the inserted text if it
  78. exists and is readable."
  79.  
  80.   (interactive (list
  81.         (let ((completion-ignored-extensions
  82.                (cons ".sub" completion-ignored-extensions)))
  83.           (read-file-name "Template file: " auto-template-dir nil t))))
  84.  
  85.   ;; If not called with a template file name, create one from the current
  86.   ;; buffer's file name if this is a new file.
  87.   (if (or template-file
  88.       (file-exists-p (buffer-file-name)))
  89.       nil
  90.     (setq template-file
  91.       (let* ((buffer-file-name (buffer-file-name))
  92.          (suffix (and buffer-file-name
  93.                   (auto-template-get-suffix buffer-file-name)))
  94.          (file (and suffix
  95.                 (expand-file-name (concat suffix "." suffix)
  96.                           auto-template-dir))))
  97.         (and file
  98.          (file-readable-p file)
  99.          file))))
  100.  
  101.   ;; Do our stuff if we've got a template file.
  102.   (if template-file
  103.       (let ((substitution-file (concat
  104.                 (auto-template-strip-suffix template-file)
  105.                 ".sub")))
  106.  
  107.     (let ((original-buffer (current-buffer))
  108.           (work-buffer (get-buffer-create " *auto-template*"))
  109.           substitutions)
  110.       ;; Note - I use a temporary buffer even when there is no
  111.       ;; substitutions file so that UNDO makes a new file's buffer go back
  112.       ;; to `unmodified'.  This didn't happen when I used `insert-file' to
  113.       ;; insert the file directly into the buffer - undo removed the text
  114.       ;; but left the buffer flagged as modified.
  115.       (set-buffer work-buffer)
  116.       (widen)
  117.       (erase-buffer)
  118.  
  119.       ;; Read substitutions into a list if the file is readable.
  120.       (if (file-readable-p substitution-file)
  121.           (progn
  122.         (insert "()")        ; list delimiters
  123.         (forward-char -1)
  124.         (insert-file-contents substitution-file)
  125.         (goto-char (point-min))
  126.         (setq substitutions (read work-buffer))))
  127.  
  128.       ;; Read in the template file.
  129.       (erase-buffer)
  130.       (insert-file-contents template-file)
  131.  
  132.       ;; Apply the substitutions.
  133.       (while substitutions
  134.         (let ((place-holder (car substitutions))
  135.           (replacement (car (cdr substitutions))))
  136.           (setq substitutions (cdr (cdr substitutions)))
  137.           (setq replacement
  138.             (if (stringp replacement)
  139.             (read-string replacement)
  140.               (eval replacement)))
  141.           (save-excursion
  142.         (while (search-forward place-holder nil t)
  143.           (replace-match replacement t t)))
  144.           ))
  145.  
  146.       ;; Insert the (possibly modified) template.
  147.       (set-buffer original-buffer)
  148.       (insert-buffer work-buffer)
  149.       (kill-buffer work-buffer)
  150.       ))))
  151.  
  152.  
  153. (defun auto-template-get-suffix (file)
  154.   "Return the file suffix for FILE, or NIL if none."
  155.   (if (string-match "\\.\\([^./]+\\)$" file)
  156.       (substring file (match-beginning 1) (match-end 1))))
  157.  
  158.  
  159. (defun auto-template-strip-suffix (file)
  160.   "Return FILE without its file suffix."
  161.   (if (string-match "\\.[^./]+$" file)
  162.       (substring file 0 (match-beginning 0))
  163.     file))
  164.