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

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