[skel] / skel.el.in

;;; -*-emacs-lisp-*-
;;;
;;; $Id: skel.el.in,v 1.5 2004/04/08 01:36:28 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.

;;;----- Variables (largely tweakable) --------------------------------------

(defvar skel-directory-list '(".skel" "")
  "*List of directory names which contain skeleton files.")

(defvar skel-skeleton-path '("/etc/skel" "@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 (consp 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
	(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 (save-match-data
			 (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)

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