mdw@git.distorted.org.uk Git - skel/blob - skel.el.in

   1 ;;; -*-emacs-lisp-*-
   2 ;;;
   3 ;;; $Id: skel.el.in,v 1.2 1999/05/05 19:30:38 mdw Exp $
   4 ;;;
   5 ;;; Filling in skeletons
   6 ;;;
   7 ;;; (c) 1998 Mark Wooding
   8 ;;;
   9
  10 ;;;----- Licensing notice ---------------------------------------------------
  11 ;;;
  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.
  16 ;;;
  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.
  21 ;;;
  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.
  25
  26 ;;;----- Revision history ---------------------------------------------------
  27 ;;;
  28 ;;; $Log: skel.el.in,v $
  29 ;;; Revision 1.2  1999/05/05 19:30:38  mdw
  30 ;;; Misc tidying.
  31 ;;;
  32 ;;; Revision 1.1.1.1  1999/04/05 13:44:59  mdw
  33 ;;; Initial import.
  34 ;;;
  35
  36 ;;;----- Variables (largely tweakable) --------------------------------------
  37
  38 (defvar skel-directory-list '(".skel" "")
  39   "*List of directory names which contain skeleton files.")
  40
  41 (defvar skel-skeleton-path '("@skeldir@" "~/skel" "~/src/skel")
  42   "*List of directories to search for skeleton data anyway.")
  43
  44 (defvar skel-skelrc '(".skelrc" "skelrc")
  45   "*File containing skeleton substitution data, looked up using the standard
  46 skeleton search mathod.")
  47
  48 (defvar skel-alist '()
  49   "Alist of values to substitute into a skeleton.  It is filled in by skelrc
  50 files and user interaction.
  51
  52 The alist's keys are symbols, interned from the placeholder strings in the
  53 skeleton file.  The values are forms to be evaluated.  In the simplest case,
  54 the form is a string added as a result of user interaction; however, it could
  55 just as easily be a function call or something similarly complicated.")
  56
  57 ;;;----- Finding skeleton files ---------------------------------------------
  58
  59 (defun skel-do-join (acc jfun ll s)
  60   "Recursive guts of skel-join."
  61   (if ll
  62       (if (car ll)
  63           (skel-do-join (skel-do-join acc jfun (cdr ll)
  64                                       (funcall jfun s (car (car ll))))
  65                         jfun (cons (cdr (car ll)) (cdr ll)) s)
  66         acc)
  67     (cons s acc)))
  68
  69 (defun skel-join (jfun base &rest ll)
  70   "Return a list built from joining elements from the given lists in order,
  71 left to right.  JFUN is a function of two arguments which can join items
  72 together.  BASE is the initial item."
  73   (nreverse (skel-do-join nil jfun ll base)))
  74
  75 (defun skel-do-parents (dir acc)
  76   "Tail recursive guts of skel-parents"
  77   (setq acc (cons dir acc))
  78   (setq dir (substring dir 0 (string-match "/[^/]*/?$" dir)))
  79   (if (string= dir "")
  80       (cons "/" acc)
  81     (skel-do-parents dir acc)))
  82
  83 (defun skel-parents (dir)
  84   "Returns a list of DIR, DIR's parent directory, etc., all the way up to the
  85 root."
  86   (setq dir (expand-file-name dir))
  87   (nreverse (skel-do-parents dir nil)))
  88
  89 (defun skel-do-find (l all acc)
  90   (if l
  91       (let ((n (car l)))
  92         (if (and (file-readable-p n) (file-regular-p n))
  93             (if all
  94                 (skel-do-find (cdr l) all (cons (abbreviate-file-name n) acc))
  95               (abbreviate-file-name n))
  96           (skel-do-find (cdr l) all acc)))
  97     acc))
  98
  99 (defun skel-find-skeleton (name &optional all acc)
 100   "Searches for skeleton files.  NAME is the name of the file to find, or
 101 a list of possible names.
 102
 103 If ALL is nil, or omitted, return only the first matching filename
 104 encountered.  Otherwise, return a list of all matching names, most `global'
 105 first.  ACC is a base list to which the matching filenames are prepended."
 106
 107   ;; --- Build one big list of all the possible names ---
 108
 109   (let ((l (skel-join (lambda (x y) (if (string= y "")
 110                                         x
 111                                       (expand-file-name y x)))
 112                       nil
 113                       (append (skel-parents default-directory)
 114                               skel-skeleton-path)
 115                       skel-directory-list
 116                       (if (consp name) name (cons name nil)))))
 117
 118     ;; --- Now filter out any which aren't interesting ---
 119
 120     (skel-do-find l all acc)))
 121
 122 ;;;----- Processing file skeletons ------------------------------------------
 123
 124 (defun skel-include (file)
 125   "Includes the skeleton rc FILE."
 126   (let ((rc (skel-find-skeleton file t)))
 127     (while rc
 128       (load (car rc) nil t t)
 129       (setq rc (cdr rc)))))
 130
 131 (defun skel-lookup (name)
 132
 133   "Reads the value of symbol NAME in skel-alist.  If there is no currrent
 134 value, the user is prompted for one."
 135
 136   ;; --- Resolve NAME into a symbol ---
 137
 138   (if (stringp name)
 139       (setq name (intern name)))
 140
 141   ;; --- Look up the value ---
 142   ;;
 143   ;; Add it to the list if we've not seen it before.  Protect ourselves
 144   ;; against functions which do regexp matching.
 145
 146   (let ((pair (assq name skel-alist))
 147         value)
 148     (if pair
 149         (save-match-data (setq value (eval (cdr pair))))
 150       (setq value (read-string (format "Value for %s: " name)))
 151       (setq skel-alist (cons (cons name value) skel-alist)))
 152     value))
 153
 154 (defun skel-do-fill-in ()
 155   "Does the actual donkey-work of filling in a file.  For each fill-in area
 156 in the current buffer, the function looks to see if the item in question has
 157 been entered into ALIST: if so, it is replaced automatically; otherwise the
 158 user is promted to enter a string to substitute into the buffer at this
 159 point."
 160   (if (re-search-forward "\\[\\[\\([^]]*\\)\\]\\]" nil t)
 161       (progn
 162         (replace-match (skel-lookup (match-string 1)) t t nil)
 163         (goto-char (match-beginning 0))
 164         (skel-do-fill-in))))
 165
 166 ;;;----- Creating new files from skeletons ----------------------------------
 167
 168 (defun skel-do-create-file (name switch &optional skel)
 169
 170   "Does the main work of creating a file based on a skeleton.  The SWITCH
 171 argument is called to display the buffer."
 172
 173   ;; --- Some local variables ---
 174   ;;
 175   ;; This is a little bit of a hack, but do I look like someone who cares?
 176
 177   (let (ext)
 178
 179     ;; --- Find out if the file's there already ---
 180
 181     (if (file-exists-p name)
 182         (or (yes-or-no-p
 183              (format "File %s already exists.  Overwrite? " name))
 184             (error "Aborted!")))
 185
 186     ;; --- Fiddle with the filename ---
 187
 188     (cond ((stringp skel) (let ((extind (string-match "\.[^.]*$" skel)))
 189                             (setq ext (and extind (substring skel extind)))))
 190           (skel (progn
 191                   (setq ext (read-string "Extension: "))
 192                   (or (string= ext "") (setq ext (concat "." ext)))))
 193           (t (let ((extind (string-match "\.[^.]*$" name)))
 194                (setq ext (and extind (substring name extind))))))
 195     (setq skel (concat "skeleton" (or ext "")))
 196
 197     ;; --- Find the skeleton filename ---
 198
 199     (setq skel (or (skel-find-skeleton skel)
 200                    (skel-find-skeleton "skeleton")
 201                    (error "Couldn't find skeleton file %s" skel)))
 202
 203     ;; --- Visit the file and destroy its contents ---
 204
 205     (funcall switch (find-file-noselect name))
 206     (kill-region (point-min) (point-max))
 207     (insert-file skel)
 208
 209     ;; --- Mangle the skeleton data in the file ---
 210
 211     (make-local-variable 'skel-alist)
 212     (setq skel-alist '())
 213
 214     ;; --- Read the default values to insert ---
 215
 216     (let ((rc (append
 217                (skel-find-skeleton skel-skelrc t)
 218                (and ext
 219                     (skel-find-skeleton
 220                      (if (listp skel-skelrc)
 221                          (mapcar (lambda (x) (concat x ext)) skel-skelrc)
 222                        (concat skel-skelrc ext))
 223                      t)))))
 224       (while rc
 225         (load (car rc) nil t t)
 226         (setq rc (cdr rc))))
 227
 228     ;; --- Now do substitution ---
 229
 230     (skel-do-fill-in)
 231     (not-modified)))
 232
 233 ;;;----- User commands ------------------------------------------------------
 234
 235 (defun skel-create-file (name &optional skel)
 236   "Creates a new file called NAME and visits it.  If SKEL is non-`nil', it is
 237 the name of a skeleton file to insert and substitute.  Otherwise the skeleton
 238 file's name is derived from NAME by taking NAME's extension and appending it
 239 to `skel'."
 240   (interactive "FSkeleton create file: \nP")
 241   (skel-do-create-file name 'switch-to-buffer skel))
 242
 243 (defun skel-create-file-other-window (name &optional skel)
 244   "Like skel-create-file, but in another window."
 245   (interactive "FSkeleton create file in other window: \nP")
 246   (skel-do-create-file name 'switch-to-buffer-other-window skel))
 247
 248 (defun skel-create-file-other-frame (name &optional skel)
 249   "Like skel-create-file, but in another frame."
 250   (interactive "FSkeleton create file in other frame: \nP")
 251   (skel-do-create-file name 'switch-to-buffer-other-frame skel))
 252
 253 ;;;----- Is that all there is? ----------------------------------------------
 254
 255 (provide 'skel)