#!/usr/bin/guile -s
!#

(use-modules (ice-9 debug)
	     (ice-9 getopt-long) 
	     (srfi srfi-1)
	     (srfi srfi-2))

(define cmdline (command-line))
(define progname (car cmdline))
(define (version progname) (format #t "~A version 1.99 ~%" progname) #t)

;add key to alist if key not present there
(define (alist-add  key value alist)
  (if (not (assoc key alist))
    (acons key value alist)
    alist))

;find and read map
(define (get-map)
  (let loop ((item (read)))
    (cond ((eof-object? item) #f)
	  ((and (pair? item) (eq? (car item) '/wizard)) item)
	  (else (loop (read))))))

;convert map entry to assoc list
(define (parse-map filename)
  (let ((wizard-map 
	  (with-input-from-file filename
				(lambda () (get-map)))))
    (and (not wizard-map) (error "wizard map wasn't found"))
    (cons (take wizard-map 7)
	  (let loop ((lst (drop wizard-map 7))
		     (result '()))
	    (if (null? lst) result
	      (loop (drop lst 4)
		    (acons (cadr lst) (cadddr lst) result)))))))

;convert assoc to tail of map entry
(define (unparse-map lst)
  (define (gen-step num) (string->symbol (format #f "step~A" num)))
  (define (gen-desc num) (string->symbol (format #f "description~A" num)))
  (let loop ((item lst)
	     (num 1)
	     (result '()))
    (if (null? item)
      result
      (loop (cdr item)
	    (+ num 1)
	    (append result
		    (list (gen-step num) (caar item)
			  (gen-desc num) (cdar item)))))))

(define (put-map lst filename)
  (with-output-to-file filename
		       (lambda ()
			 (write '(/ view /welcome))(newline)
			 (write lst)(newline)
			 (write '(include "accmap2.scm"))(newline)
			 (write '(include "*.map"))(newline))))


(define (remove-module url filename)
  (let ((wizard-map (parse-map filename)))
    (put-map (append (car wizard-map)
		     (unparse-map (alist-delete url (cdr wizard-map))))
	     filename))
  #t)

(define (add-module url description filename)
  (let ((wizard-map (parse-map filename)))
    (put-map (append (car wizard-map)
		     (unparse-map (alist-add url description (cdr wizard-map))))
	     filename))
  #t)
    
;(remove-module "/goodbye" "accmap.scm")
;(add-module "/x11" "Setup X11" "accmap.scm")

(define (usage progname)
  (format #t "Usage:  ~A --add uri description filename~%" progname)
  (format #t "or: ~A --remove uri filename~%~%" progname)
  (format #t "  -h, --help     display help screen~%")
  (format #t "  -v, --version  display version information ~%")
  (format #t "  -a,--add  add module to control center map~%")
  (format #t "  -r,--remove remove module from control center map~%~%")
  (format #t "  Report bugs to <inger@altlinux.ru>~%")
  #t)

(define option-spec                                                                          
  '((version (single-char #\v) (value #f))                                                   
    (help    (single-char #\h) (value #f))                                                   
    (add  (single-char #\a) (value #f))                                                   
    (remove    (single-char #\r) (value #f))))
(define options (getopt-long cmdline option-spec))

(and (option-ref options 'help #f) (usage progname) (quit))                           
(and (option-ref options 'version #f) (version progname) (quit))

(and-let* ((has-opt (option-ref options 'add #f))
	   (args (option-ref options '() #f)))
	  (and (= (length args) 3) 
	       (add-module (car args) (cadr args) (caddr args))
	       (quit)))
(and-let* ((has-opt (option-ref options 'remove #f))
	   (args (option-ref options '() #f)))
	  (and (= (length args) 2)
	       (remove-module (car args) (cadr args))
	       (quit)))
(usage progname)
(quit)

