Re: identity problem

[Vollmer Marius <mvo zagadka ping de>]

Mario Filipe <mjnf@neptuno.sc.uevora.pt> writes:

> Can someone explain to me how do i fix the identity problem (see below). I
> have guile 1.2 and slib 2c0
> make[2]: Entering directory `/home/mjnf/gnome/guile-gtk'
> ../././guile-gtk/gen-typeinfo infomac gtk.defs ../././guile-gtk/guile.details
> >tmp \
> && mv tmp gtk-types.h
> guile: Unbound variable: identity

You can either

- upgrade to a recent snapshor of Guile, which works with SLIB 2c0
- downgrade SLIB to 2b
- hack gen-typeinfo to not use format from SLIB.  Here is mini-format
  which you can use instead.

(define-module (mini-format))

(define-public (format-with-list-template dst fmt . args)
  (cond
   ((eq? dst #t)
    (apply format-with-list-template (current-output-port) fmt args))
   ((eq? dst #f)
    (call-with-output-string
     (lambda (p)
       (apply format-with-list-template p fmt args))))
   (else
    (let loop ((fmt fmt)
	       (args args))
      (if (null? fmt)
	  #t
	  (let ((f (car fmt)))
	    (cond
	     ((string? f)
	      (display f dst)
	      (loop (cdr fmt) args))
	     ((procedure? f)
	      (loop (cdr fmt) (f args dst)))
	     (else
	      (error "unknown formatting op" f)))))))))

(define (fmt-display args dst)
  (display (car args) dst)
  (cdr args))

(define (fmt-write args dst)
  (write (car args) dst)
  (cdr args))

(define (fmt-newline args dst)
  (newline dst)
  args)

(define-public (string-template->list-template fmt)
  (let ((tilde (string-index fmt #\~)))
    (if (and tilde (< tilde (string-length fmt)))
	(let* ((prefix (substring fmt 0 tilde))
	       (arg (string-ref fmt (+ tilde 1))))
	  (if (not (memq arg '(#\a #\d #\s #\%)))
	      #f
	      (let* ((rest (string-template->list-template
			    (substring fmt (+ tilde 2))))
		     (subst
		      (case arg
			((#\a #\d)
			 fmt-display)
			((#\s)
			 fmt-write)
			((#\%)
			 (set! prefix (string-append prefix "\n"))
			 #f))))
		(and rest
		     (if (zero? (string-length prefix))
			 (cons subst rest)
			 (cons prefix (if subst
					  (cons subst rest)
					  rest)))))))
	;; no ~ in fmt
	(if (zero? (string-length fmt))
	    '()
	    (list fmt)))))

(defmacro-public mini-format-macro (dst fmt . args)
  (let ((m-fmt (and (string? fmt) (string-template->list-template fmt))))
    (if m-fmt
	`(format-with-list-template ,dst ',m-fmt ,@args)
	(error "unsupported format template" fmt))))

(define-public (mini-format dst fmt . args)
  (let ((m-fmt (and (string? fmt) (string-template->list-template fmt))))
    (if m-fmt
	(apply format-with-list-template dst m-fmt args)
	(error "unsupported format template" fmt))))