+;;; -*-emacs-lisp-*-
+;;;
+;;; $Id: skel.el.in,v 1.1 1999/04/05 13:44:59 mdw Exp $
+;;;
+;;; Filling in skeletons
+;;;
+;;; (c) 1998 Mark Wooding
+;;;
+
+;;;----- Licensing notice ---------------------------------------------------
+;;;
+;;; This program is free software; you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 2 of the License, or
+;;; (at your option) any later version.
+;;;
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program; if not, write to the Free Software Foundation,
+;;; Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
+
+;;;----- Revision history ---------------------------------------------------
+;;;
+;;; $Log: skel.el.in,v $
+;;; Revision 1.1 1999/04/05 13:44:59 mdw
+;;; Initial revision
+;;;
+
+;;;----- Variables (largely tweakable) --------------------------------------
+
+(defvar skel-directory-list '(".skel" "")
+ "*List of directory names which contain skeleton files.")
+
+(defvar skel-skeleton-path '("@skeldir@" "~/skel" "~/src/skel")
+ "*List of directories to search for skeleton data anyway.")
+
+(defvar skel-skelrc '(".skelrc" "skelrc")
+ "*File containing skeleton substitution data, looked up using the standard
+skeleton search mathod.")
+
+(defvar skel-alist '()
+ "Alist of values to substitute into a skeleton. It is filled in by skelrc
+files and user interaction.
+
+The alist's keys are symbols, interned from the placeholder strings in the
+skeleton file. The values are forms to be evaluated. In the simplest case,
+the form is a string added as a result of user interaction; however, it could
+just as easily be a function call or something similarly complicated.")
+
+;;;----- Finding skeleton files ---------------------------------------------
+
+(defun skel-do-join (acc jfun ll s)
+ "Recursive guts of skel-join."
+ (if ll
+ (if (car ll)
+ (skel-do-join (skel-do-join acc jfun (cdr ll)
+ (funcall jfun s (car (car ll))))
+ jfun (cons (cdr (car ll)) (cdr ll)) s)
+ acc)
+ (cons s acc)))
+
+(defun skel-join (jfun base &rest ll)
+ "Return a list built from joining elements from the given lists in order,
+left to right. JFUN is a function of two arguments which can join items
+together. BASE is the initial item."
+ (nreverse (skel-do-join nil jfun ll base)))
+
+(defun skel-do-parents (dir acc)
+ "Tail recursive guts of skel-parents"
+ (setq acc (cons dir acc))
+ (setq dir (substring dir 0 (string-match "/[^/]*/?$" dir)))
+ (if (string= dir "")
+ (cons "/" acc)
+ (skel-do-parents dir acc)))
+
+(defun skel-parents (dir)
+ "Returns a list of DIR, DIR's parent directory, etc., all the way up to the
+root."
+ (setq dir (expand-file-name dir))
+ (nreverse (skel-do-parents dir nil)))
+
+(defun skel-do-find (l all acc)
+ (if l
+ (let ((n (car l)))
+ (if (and (file-readable-p n) (file-regular-p n))
+ (if all
+ (skel-do-find (cdr l) all (cons (abbreviate-file-name n) acc))
+ (abbreviate-file-name n))
+ (skel-do-find (cdr l) all acc)))
+ acc))
+
+(defun skel-find-skeleton (name &optional all acc)
+ "Searches for skeleton files. NAME is the name of the file to find, or
+a list of possible names.
+
+If ALL is nil, or omitted, return only the first matching filename
+encountered. Otherwise, return a list of all matching names, most `global'
+first. ACC is a base list to which the matching filenames are prepended."
+
+ ;; --- Build one big list of all the possible names ---
+
+ (let ((l (skel-join (lambda (x y) (if (string= y "")
+ x
+ (expand-file-name y x)))
+ nil
+ (append (skel-parents default-directory)
+ skel-skeleton-path)
+ skel-directory-list
+ (if (listp name) name (cons name nil)))))
+
+ ;; --- Now filter out any which aren't interesting ---
+
+ (skel-do-find l all acc)))
+
+;;;----- Processing file skeletons ------------------------------------------
+
+(defun skel-include (file)
+ "Includes the skeleton rc FILE."
+ (let ((rc (skel-find-skeleton file t)))
+ (while rc
+ (load (car rc) nil t t)
+ (setq rc (cdr rc)))))
+
+(defun skel-lookup (name)
+
+ "Reads the value of symbol NAME in skel-alist. If there is no currrent
+value, the user is prompted for one."
+
+ ;; --- Resolve NAME into a symbol ---
+
+ (if (stringp name)
+ (setq name (intern name)))
+
+ ;; --- Look up the value ---
+ ;;
+ ;; Add it to the list if we've not seen it before. Protect ourselves
+ ;; against functions which do regexp matching.
+
+ (let ((pair (assq name skel-alist))
+ value)
+ (if pair
+ (save-match-data (setq value (eval (cdr pair))))
+ (setq value (read-string (format "Value for %s: " name)))
+ (setq skel-alist (cons (cons name value) skel-alist)))
+ value))
+
+(defun skel-do-fill-in ()
+ "Does the actual donkey-work of filling in a file. For each fill-in area
+in the current buffer, the function looks to see if the item in question has
+been entered into ALIST: if so, it is replaced automatically; otherwise the
+user is promted to enter a string to substitute into the buffer at this
+point."
+ (if (re-search-forward "\\[\\[\\([^]]*\\)\\]\\]" nil t)
+ (progn
+ (replace-match (skel-lookup (match-string 1)) t t nil)
+ (goto-char (match-beginning 0))
+ (skel-do-fill-in))))
+
+;;;----- Creating new files from skeletons ----------------------------------
+
+(defun skel-do-create-file (name switch &optional skel)
+
+ "Does the main work of creating a file based on a skeleton. The SWITCH
+argument is called to display the buffer."
+
+ ;; --- Some local variables ---
+ ;;
+ ;; This is a little bit of a hack, but do I look like someone who cares?
+
+ (let (ext rc)
+
+ ;; --- Find out if the file's there already ---
+
+ (if (file-exists-p name)
+ (or (yes-or-no-p
+ (format "File %s already exists. Overwrite? " name))
+ (error "Aborted!")))
+
+ ;; --- Fiddle with the filename ---
+
+ (cond ((stringp skel) (let ((extind (string-match "\.[^.]*$" skel)))
+ (setq ext (and extind (substring skel extind)))))
+ (skel (progn
+ (setq ext (read-string "Extension: "))
+ (or (string= ext "") (setq ext (concat "." ext)))))
+ (t (let ((extind (string-match "\.[^.]*$" name)))
+ (setq ext (and extind (substring name extind))))))
+ (setq skel (concat "skeleton" (or ext "")))
+
+ ;; --- Find the skeleton filename ---
+
+ (setq skel (or (skel-find-skeleton skel)
+ (skel-find-skeleton "skeleton")
+ (error "Couldn't find skeleton file %s" skel)))
+
+ ;; --- Visit the file and destroy its contents ---
+
+ (funcall switch (find-file-noselect name))
+ (kill-region (point-min) (point-max))
+ (insert-file skel)
+
+ ;; --- Mangle the skeleton data in the file ---
+
+ (make-local-variable 'skel-alist)
+ (setq skel-alist '())
+
+ ;; --- Read the default values to insert ---
+
+ (let ((rc (append
+ (skel-find-skeleton skel-skelrc t)
+ (and ext
+ (skel-find-skeleton
+ (if (listp skel-skelrc)
+ (mapcar (lambda (x) (concat x ext)) skel-skelrc)
+ (concat skel-skelrc ext))
+ t)))))
+ (while rc
+ (load (car rc) nil t t)
+ (setq rc (cdr rc))))
+
+ ;; --- Now do substitution ---
+
+ (skel-do-fill-in)
+ (not-modified)))
+
+;;;----- User commands ------------------------------------------------------
+
+(defun skel-create-file (name &optional skel)
+ "Creates a new file called NAME and visits it. If SKEL is non-`nil', it is
+the name of a skeleton file to insert and substitute. Otherwise the skeleton
+file's name is derived from NAME by taking NAME's extension and appending it
+to `skel'."
+ (interactive "FSkeleton create file: \nP")
+ (skel-do-create-file name 'switch-to-buffer skel))
+
+(defun skel-create-file-other-window (name &optional skel)
+ "Like skel-create-file, but in another window."
+ (interactive "FSkeleton create file in other window: \nP")
+ (skel-do-create-file name 'switch-to-buffer-other-window skel))
+
+(defun skel-create-file-other-frame (name &optional skel)
+ "Like skel-create-file, but in another frame."
+ (interactive "FSkeleton create file in other frame: \nP")
+ (skel-do-create-file name 'switch-to-buffer-other-frame skel))
+
+;;;----- Is that all there is? ----------------------------------------------
+
+(provide 'skel)