#!/bin/sh
: ; exec klone $0 "$@"
; The above line finds the klone executable in the $PATH
;; Si y en a que ca interesse, voila un srcipt klone qui fait un shadow
;; dir. Il a qq goodies (peut etre bugge - en tout cas ca marche pour
;; k-Edit):
;; 
;; kl-mkshadowdir real shadow [-c <c-pat>]* [-e <e-pat>]*
;; 
;; Les fichiers cites dans l'option -c (qui est multiple) vont etre
;; copies, ceux cite dans l'option -e (exclude) ne sont pas traite. Par
;; exemple pour k-Edit:
;; 
;; kl-mkshadowdir k-Edit linux.k-Edit \
;;     -c Imakefile -c k-Edit.def \        # fichiers de config
;;     -e "*.o" -e "*~" -e "Makefile*"     # fichiers dont il ne faut rien faire
;; 
;; [Noter que ca permet de faire un shadow dir d'un repertoire qui a deja
;; ete compiole, sans avoir a faire de 'make clean' avant]
;; 
;; Anselm.

(setq *real-path* ())
(setq *shadow-path* ())
(setq *c-list* ())
(setq *e-list* ())
(setq *verbose* t)

;--------------------------------------------------------------------------
; path utilities:
; path-to-list: "explode" a path
; list-to-path: "implode" a path 
; relativize:   builds the relative path 
;--------------------------------------------------------------------------

(defun path-to-list (path &aux ret cur)
  "Transform a path into a list of components."
  (while (setq cur (match "^(.*[/])([^/]*)$" path 1 2))
	 (setq ret (cons #[cur 1] ret))
	 (setq path (subseq #[cur 0] 0 (- (length #[cur 0]) 1))))
  (cons path ret) )

(defun list-to-path (root items)
  "Transform a list of components to a path."
  (dolist (i items) (setq root (+ root "/" i)))
  root )

(defun real-to-shadow (name)
  (with (name-list (path-to-list name)
	 real-list (path-to-list *real-path*)
	 idx 0)
	(while (= #[name-list idx] #[real-list idx])
	       (++ idx))
	(list-to-path *shadow-path* (subseq name-list idx))) )
	
(defun relativize (path to)
  (with (path-list (path-to-list path)
	 to-list   (path-to-list to)
	 ret ()
	 idx  0
	 tl (length to-list))
	(break)
	(while (and (< idx tl) (= #[path-list idx] #[to-list idx]))
	       (setq ret (cons #[to-list idx] ret))
	       (++ idx))
	(setq rest (subseq path-list idx))
	(while (< idx (- tl 1))
	       (setq ret (cons ".." ret))
	       (++ idx))
	(list-to-path "." (+ ret rest))) )

;--------------------------------------------------------------------------
; Used shell commands
;--------------------------------------------------------------------------

(defun make-directory (f &optional verbose)
  (with (shadow (real-to-shadow f))
	(and verbose (? "mkdir " shadow "\n"))
	(sh mkdir ,shadow)) )

(defun link-file (f &optional verbose)
  (with (shadow (real-to-shadow f))
	(and verbose (? "ln -s " f " " shadow "\n"))
	(sh ln -s ,(relativize f shadow) ,shadow)) )

(defun copy-file (f &optional verbose)
  (with (shadow (real-to-shadow f))
	(and verbose (? "cp " f " " shadow "\n"))
	(sh cp ,f ,shadow)) )


;--------------------------------------------------------------------------
; usage, parsing command line, and engine
;--------------------------------------------------------------------------

(defun usage ()
  (? "kl-mkshadowdir real-path shadow-path [-c pat] [-e pat]\n")
  (exit 0) )

(defun parse-command-line ()
  (if (< (length *arguments*) 3) (usage))
  ;; Get real-path:
  (setq *real-path* #[*arguments* 1])
  (setq *shadow-path* #[*arguments* 2])
  (if (not (= (file-type *real-path*) 'directory))
      (progn (? "Invalid real-path: " *real-path* "\n")
	     (exit 1)))
  ;; Get the list of copy files:
  (with (idx 3 l (length *arguments*))
	(while (< idx l)
	       (if (= #[*arguments* idx] "-c")
		   (setq *c-list* (cons #[*arguments* (++ idx)] *c-list*))
		   (= #[*arguments* idx] "-e")
		   (setq *e-list* (cons #[*arguments* (++ idx)] *e-list*))
		   t (usage))
	       (++ idx))) )

(defun main ()
  (parse-command-line)
  ;; First, the links
  (sh mkdir ,*shadow-path*)
  (mapdir *real-path*
	  (lambda (f) (link-file f *verbose*))
	  :recurse t
	  :excluding (+ *c-list* *e-list*)
	  :dirfct (lambda (d) (make-directory d *verbose*) t))
  ;; Than the copy-list
  (if *c-list*
      (mapdir *real-path*
	      (lambda (f) (copy-file f *verbose*))
	      :recurse t
	      :including *c-list*
	      :excluding *e-list*))
  (exit 0))


(main)

;;; EMACS MODES
;;; Local Variables: ***
;;; mode:lisp ***
;;; End: ***