[skel] / skel.el.in

;;; -*-emacs-lisp-*-
;;;
;;; $Id: skel.el.in,v 1.4 2003/11/29 23:35:38 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.4  2003/11/29 23:35:38  mdw
;;; Debianization.
;;;
;;; Revision 1.3  1999/08/20 07:40:51  mdw
;;; Slight twiddles to the Lisp code.
;;;
;;; Revision 1.2  1999/05/05 19:30:38  mdw
;;; Misc tidying.
;;;
;;; Revision 1.1.1.1  1999/04/05 13:44:59  mdw
;;; Initial import.
;;;

;;;----- 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
	(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)

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