fyi: beginnings of LAML support for guile

[thi <ttn at mingle dot glug dot org>]

in comp.lang.scheme there is a thread discussing LAML (lisp abstraction
markup language) by Kurt Normark.  it sits on top of scm and mzscheme
currently, so in a fit of procrastination, i started munging it to use
guile.  for those interested, below is a modified laml-config.scm (from
version 12 of LAML), but there is more work to be done and i've lost
interest.

the config system uses scheme and is not autoconf-based, which was
initially interesting, but code (dis?)organization requires changes to
many places, which is a PITA -- like vc.el in emacs.  :-/

anyway, will go back to looking at extract by C.McGrew.

(both of these systems are released under GPL, btw.)

thi


----------------------
;;;; This program configures your LAML system. By calling the procedure
;;;; laml-config (wihtout parameters) you read the configuration file
;;;; "configuration" from this directory, and overwrites some files
;;;; (relative to the laml directory).  See `setup-file-descriptors'.
;;;;
;;;; Usage:
;;;;   1. Load this file from the current directory.
;;;;   2. Call: (laml-config).
;;;;   3. If errors are located in your configuration the program
;;;;      reports them. Correct them are goto back to step 2.
;;;;   4. Exit Scheme.
;;;;
;;;; See also the WWW installation guide for further information.

(define supported-platforms '(windows unix))
(define supported-scheme-systems '(scm mzscheme guile))
(define supported-operating-systems '(win98 win95 nt40 solaris linux))
(define supported-kinds-of-emacs '(gnu-emacs win-emacs))
(define supported-laml-activations '(rich poor))

(load "../lib4/general.scm")
(load "../lib4/file-read.scm")

(define config-alist '())		; reassigned later.

; A list of file-descriptor. A file descriptor is itself a list
; of template file (unconfigured) and destination file (configured).
(define setup-file-descriptors
  (map (lambda (pair)
	 (let ((file (car pair))
	       (destdir (cdr pair)))
	   (list (string-append "templates/" file)
		 (string-append destdir "/" file))))
       '(("laml.scm"			. "..")
	 ("laml.el"			. "..")
	 ("laml.init"			. "..")
	 ;; The following two are command files with which to start laml
	 ;; from a command prompt.
	 ("laml.bat"			. "../bin")
	 ("laml"			. "../bin")
	 ("dot-emacs-contribution.el"	. "../emacs-support"))))

; Perform the laml configuration from the information in
; setup-file-descriptors and configuration.  The parameter configuration
; defaults to the global variable config-alist.  This procedure overwrites a
; number of files in the root of the laml directory and in the laml bin
; directory.
(define (laml-config . configuration)
  (set! wm 0)
  (let ((config-alist-1 (if (not (null? configuration))
			    (car configuration)
			    (file-read "configuration"))))
    (check-configuration! config-alist-1)
    (display-message (string-append (as-string wm) " warnings!"))
    (for-each (lambda (file-descriptor)
		(configure-file (car file-descriptor)
				config-alist-1
				(cadr file-descriptor)))
	      setup-file-descriptors)
    (display-message
     (if (> wm 0)
	 "You should fix the problems reported above and run laml-config again."
	 "I have checked your configuration, and it seems to be OK."))

    (display-message
     (string-append "The LAML configuration files are now redefined"
		    (if (> wm 0) ", but probably not correct yet." ".")))
    (for-each display-message
	      '("Please goto the next step in the LAML setup procedure,"
		"as described on WWW installation page."))))

(define (slash-terminated? str)
  (eq? (string-ref str (- (string-length str) 1)) #\/))

(define wm 0)

(define (warn-notedly . msg-elements)
  (display-warning (apply string-append (map as-string msg-elements)))
  (set! wm (+ 1 wm)))

(define (check-configuration! configuration)
  (let (
        (laml-dir (get 'laml-dir configuration))
        (scheme-system (get 'scheme-system  configuration))
        (laml-platform (get 'laml-platform configuration))
        (operating-system (get 'operating-system configuration))
        (kind-of-emacs (get 'kind-of-emacs  configuration))
        (scm-exec (get 'scm-exec configuration))
        (mzscheme-exec (get 'mzscheme-exec configuration))
        (laml-library (get 'laml-library configuration))
        (laml-activation (get 'laml-activation configuration))
        (laml-default-output-file (get 'laml-default-output-file configuration))
        (laml-default-output-directory (get 'laml-default-output-directory configuration))
        (computer-system (get 'computer-system configuration)))

    (or (slash-terminated? laml-dir)
	(warn-notedly "last char in laml-dir must be a '/': " laml-dir))

    (and (slash-terminated? scm-exec)
	 (warn-notedly "last char in scm-exec must not be a '/': " scm-exec))

    (or (memq laml-platform supported-platforms)
	(warn-notedly "laml-platform must be one of "
		      supported-platforms ": " laml-platform))

    (and (slash-terminated? mzscheme-exec)
	 (warn-notedly "last char in mzscheme-exec must not be a '/': "
		       mzscheme-exec))

    (and (eq? laml-platform 'unix)
	 (not (directory-exists? laml-dir))
	 (warn-notedly "The laml directory is non-existing: " laml-dir))

    (and (eq? laml-platform 'unix)
	 (eq? scheme-system 'scm)
	 (not (file-exists? scm-exec))
	 (warn-notedly "The SCM executable does not exist: " scm-exec))

    (let ((exe (string-append mzscheme-exec ".exe")))
      (and (eq? laml-platform 'windows)
	   (eq? scheme-system 'mzscheme)
	   (not (file-exists? exe))
	   (warn-notedly "The MzScheme executable does not exist: " exe)))

    (or (memq scheme-system supported-scheme-systems)
	(warn-notedly "scheme-system must be one of "
		      supported-scheme-systems ": " scheme-system))

    (or (memq operating-system supported-operating-systems)
	(warn-notedly "operating system must be one of "
		      supported-operating-systems ": " operating-system))

    (or (memq kind-of-emacs supported-kinds-of-emacs)
	(warn-notedly "kind-of-emacs must be one of "
		      supported-kinds-of-emacs ": " kind-of-emacs))

    (and (eq? laml-platform 'unix)
	 (let ((lib (string-append laml-dir laml-library)))
	   (and (not (directory-exists? lib))
		(warn-notedly "The laml library directory is non-existing: "
			      lib))))

    (or (memq laml-activation supported-laml-activations)
	(warn-notedly "laml-activation must be one of "
		      supported-laml-activations ": " laml-activation))

    ))

; Configure file f (relative path from this directory) using config-alist.
; Write result to destination-path, thereby overwriting it if it exists
; already.
(define (configure-file f config-alist destination-path)
  (display-message (string-append "configuring file: " f))
  (let* ((file-text (read-text-file f))
         (configured-file-text (configure-string file-text config-alist)))
    (if (file-exists? destination-path)
        (delete-file destination-path))
    (write-text-file configured-file-text destination-path)))

(define (configure-string str config-alist)
  (if (null? config-alist)
      str
      (configure-string
       (configure-one-option str (car config-alist))
       (cdr config-alist))))

(define (configure-one-option str config-pair)
  (let ((search-string (string-append "@" (as-string (car config-pair)) "@"))
        (replacement (as-string (cdr config-pair))))
    (replace-string str search-string replacement)))

;;; laml-config.scm ends here