3 ;;; $Id: skel.el.in,v 1.5 2004/04/08 01:36:28 mdw Exp $
5 ;;; Filling in skeletons
7 ;;; (c) 1998 Mark Wooding
10 ;;;----- Licensing notice ---------------------------------------------------
12 ;;; This program is free software; you can redistribute it and/or modify
13 ;;; it under the terms of the GNU General Public License as published by
14 ;;; the Free Software Foundation; either version 2 of the License, or
15 ;;; (at your option) any later version.
17 ;;; This program is distributed in the hope that it will be useful,
18 ;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;;; GNU General Public License for more details.
22 ;;; You should have received a copy of the GNU General Public License
23 ;;; along with this program; if not, write to the Free Software Foundation,
24 ;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
26 ;;;----- Variables (largely tweakable) --------------------------------------
28 (defvar skel-directory-list '(".skel" "")
29 "*List of directory names which contain skeleton files.")
31 (defvar skel-skeleton-path '("/etc/skel" "@skeldir@" "~/skel" "~/src/skel")
32 "*List of directories to search for skeleton data anyway.")
34 (defvar skel-skelrc '(".skelrc" "skelrc")
35 "*File containing skeleton substitution data, looked up using the standard
36 skeleton search mathod.")
38 (defvar skel-alist '()
39 "Alist of values to substitute into a skeleton. It is filled in by skelrc
40 files and user interaction.
42 The alist's keys are symbols, interned from the placeholder strings in the
43 skeleton file. The values are forms to be evaluated. In the simplest case,
44 the form is a string added as a result of user interaction; however, it could
45 just as easily be a function call or something similarly complicated.")
47 ;;;----- Finding skeleton files ---------------------------------------------
49 (defun skel-do-join (acc jfun ll s)
50 "Recursive guts of skel-join."
53 (skel-do-join (skel-do-join acc jfun (cdr ll)
54 (funcall jfun s (car (car ll))))
55 jfun (cons (cdr (car ll)) (cdr ll)) s)
59 (defun skel-join (jfun base &rest ll)
60 "Return a list built from joining elements from the given lists in order,
61 left to right. JFUN is a function of two arguments which can join items
62 together. BASE is the initial item."
63 (nreverse (skel-do-join nil jfun ll base)))
65 (defun skel-do-parents (dir acc)
66 "Tail recursive guts of skel-parents"
67 (setq acc (cons dir acc))
68 (setq dir (substring dir 0 (string-match "/[^/]*/?$" dir)))
71 (skel-do-parents dir acc)))
73 (defun skel-parents (dir)
74 "Returns a list of DIR, DIR's parent directory, etc., all the way up to the
76 (setq dir (expand-file-name dir))
77 (nreverse (skel-do-parents dir nil)))
79 (defun skel-do-find (l all acc)
82 (if (and (file-readable-p n) (file-regular-p n))
84 (skel-do-find (cdr l) all (cons (abbreviate-file-name n) acc))
85 (abbreviate-file-name n))
86 (skel-do-find (cdr l) all acc)))
89 (defun skel-find-skeleton (name &optional all acc)
90 "Searches for skeleton files. NAME is the name of the file to find, or
91 a list of possible names.
93 If ALL is nil, or omitted, return only the first matching filename
94 encountered. Otherwise, return a list of all matching names, most `global'
95 first. ACC is a base list to which the matching filenames are prepended."
97 ;; --- Build one big list of all the possible names ---
99 (let ((l (skel-join #'(lambda (x y) (if (string= y "")
101 (expand-file-name y x)))
103 (append (skel-parents default-directory)
106 (if (consp name) name (cons name nil)))))
108 ;; --- Now filter out any which aren't interesting ---
110 (skel-do-find l all acc)))
112 ;;;----- Processing file skeletons ------------------------------------------
114 (defun skel-include (file)
115 "Includes the skeleton rc FILE."
116 (let ((rc (skel-find-skeleton file t)))
118 (load (car rc) nil t t)
119 (setq rc (cdr rc)))))
121 (defun skel-lookup (name)
123 "Reads the value of symbol NAME in skel-alist. If there is no currrent
124 value, the user is prompted for one."
126 ;; --- Resolve NAME into a symbol ---
129 (setq name (intern name)))
131 ;; --- Look up the value ---
133 ;; Add it to the list if we've not seen it before. Protect ourselves
134 ;; against functions which do regexp matching.
136 (let ((pair (assq name skel-alist))
139 (save-match-data (setq value (eval (cdr pair))))
140 (setq value (read-string (format "Value for %s: " name)))
141 (setq skel-alist (cons (cons name value) skel-alist)))
144 (defun skel-do-fill-in ()
145 "Does the actual donkey-work of filling in a file. For each fill-in area
146 in the current buffer, the function looks to see if the item in question has
147 been entered into ALIST: if so, it is replaced automatically; otherwise the
148 user is promted to enter a string to substitute into the buffer at this
150 (if (re-search-forward "\\[\\[\\([^]]*\\)\\]\\]" nil t)
152 (replace-match (skel-lookup (match-string 1)) t t nil)
153 (goto-char (match-beginning 0))
156 ;;;----- Creating new files from skeletons ----------------------------------
158 (defun skel-do-create-file (name switch &optional skel)
160 "Does the main work of creating a file based on a skeleton. The SWITCH
161 argument is called to display the buffer."
163 ;; --- Some local variables ---
165 ;; This is a little bit of a hack, but do I look like someone who cares?
169 ;; --- Find out if the file's there already ---
171 (if (file-exists-p name)
173 (format "File %s already exists. Overwrite? " name))
176 ;; --- Fiddle with the filename ---
178 (cond ((stringp skel) (let ((extind (string-match "\.[^.]*$" skel)))
179 (setq ext (and extind (substring skel extind)))))
181 (setq ext (read-string "Extension: "))
182 (or (string= ext "") (setq ext (concat "." ext)))))
183 (t (let ((extind (string-match "\.[^.]*$" name)))
184 (setq ext (and extind (substring name extind))))))
185 (setq skel (concat "skeleton" (or ext "")))
187 ;; --- Find the skeleton filename ---
189 (setq skel (or (skel-find-skeleton skel)
190 (skel-find-skeleton "skeleton")
191 (error "Couldn't find skeleton file %s" skel)))
193 ;; --- Visit the file and destroy its contents ---
195 (funcall switch (find-file-noselect name))
196 (kill-region (point-min) (point-max))
199 ;; --- Mangle the skeleton data in the file ---
201 (make-local-variable 'skel-alist)
202 (setq skel-alist '())
204 ;; --- Read the default values to insert ---
207 (skel-find-skeleton skel-skelrc t)
210 (if (listp skel-skelrc)
211 (mapcar #'(lambda (x) (concat x ext)) skel-skelrc)
212 (concat skel-skelrc ext))
215 (load (car rc) nil t t)
218 ;; --- Now do substitution ---
223 ;;;----- User commands ------------------------------------------------------
225 (defun skel-create-file (name &optional skel)
226 "Creates a new file called NAME and visits it. If SKEL is non-`nil', it is
227 the name of a skeleton file to insert and substitute. Otherwise the skeleton
228 file's name is derived from NAME by taking NAME's extension and appending it
230 (interactive "FSkeleton create file: \nP")
231 (skel-do-create-file name 'switch-to-buffer skel))
233 (defun skel-create-file-other-window (name &optional skel)
234 "Like skel-create-file, but in another window."
235 (interactive "FSkeleton create file in other window: \nP")
236 (skel-do-create-file name 'switch-to-buffer-other-window skel))
238 (defun skel-create-file-other-frame (name &optional skel)
239 "Like skel-create-file, but in another frame."
240 (interactive "FSkeleton create file in other frame: \nP")
241 (skel-do-create-file name 'switch-to-buffer-other-frame skel))
243 ;;;----- Is that all there is? ----------------------------------------------