Import Debian changes 5d6-3.2debian/5d6-3.2

scm (5d6-3.2) unstable; urgency=low

  * Fix hppa compile.  Closes: #144062

scm (5d6-3.1) unstable; urgency=low

  * NMU with patch from James Troup, to fix FTBFS on sparc. Closes: #191171

scm (5d6-3) unstable; urgency=low

  * Add build depend on xlibs-dev (Closes: #148020)

scm (5d6-2) unstable; urgency=low

  * Remove libregexx-dev from build-depends.
  * Change build to use ./scmlit rather than scmlit (should fix some build
    problems) (looks like alpha is mostly building)
  * New release (Closes: #140175)
  * Built with turtlegraphics last time (Closes: #58515)

scm (5d6-1) unstable; urgency=low

  * New upstream.
  * Add xlib and turtlegr to requested list of features. (closes
    some bug)
  * Make clean actually clean most everything up.
  * Remove hacks renaming build to something else and just set build as a
    .PHONY target in debian/rules.
  * Add the turtlegr code.

scm (5d5-1) unstable; urgency=low

  * New upstream
  * Has fixes for 64 bit archs.  May fix alpha compile problem.  Does fix
    (Closes: #140175)
  * Take out -O2 arg.

scm (5d4-3) unstable; urgency=low

  * Don't link with regexx, but just use libc6's regular expression
    functions.
  * Define (terms) to output /usr/share/common-licenses/GPL (Closes:
    #119321) 

scm (5d4-2) unstable; urgency=low

  * Add texinfo to build depends (Closes: #107011)

scm (5d4-1) unstable; urgency=low

  * New upstream release.
  * Move install-info --remove to prerm.

scm (5d3-5) unstable; urgency=low

  * Move scm info files to section "The Algorithmic Language Scheme" to
    match up with guile.

scm (5d3-4) unstable; urgency=low

  * Fix build depends (Closes: #76691)

scm (5d3-3) unstable; urgency=low

  * Fix path in scm dhelp file.

scm (5d3-2) unstable; urgency=low

  * Actually put the header files in the package.  Oops.

scm (5d3-1) unstable; urgency=low

  * New upstream. (Closes: #74761)
  * Make (terms) use new license location.
  * Make use libregexx rather than librx.
  * Fix build depends for above.
  * Using new regex lib seems to fix crash (Closes: #66787)
  * Consider adding scm-dev package with headers, but instead just add the
    headers to the scm package. (Closes: #70787)
  * Add doc-base support.

1 files changed, 100 insertions, 76 deletions

diff --git a/xgen.scm b/xgen.scm
index bac5668..20d0cfd 100755
--- a/xgen.scm
+++ b/xgen.scm
@@ -1,6 +1,6 @@
 #! /usr/bin/scm \ %0 %1 %2 %3 %4 %5 %6 %7 %8 %9
 - !#
-;; Copyright (C) 1991-1999 Free Software Foundation, Inc.
+;; Copyright (C) 1991-2000 Free Software Foundation, Inc.
 ;;
 ;; 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
@@ -17,26 +17,26 @@
 ;; the Free Software Foundation, 59 Temple Place, Suite 330, Boston, MA 02111, USA.
 ;;
 ;; As a special exception, the Free Software Foundation gives permission
-;; for additional uses of the text contained in its release of GUILE.
+;; for additional uses of the text contained in its release of SCM.
 ;;
-;; The exception is that, if you link the GUILE library with other files
+;; The exception is that, if you link the SCM library with other files
 ;; to produce an executable, this does not by itself cause the
 ;; resulting executable to be covered by the GNU General Public License.
 ;; Your use of that executable is in no way restricted on account of
-;; linking the GUILE library code into it.
+;; linking the SCM library code into it.
 ;;
 ;; This exception does not however invalidate any other reasons why
 ;; the executable file might be covered by the GNU General Public License.
 ;;
 ;; This exception applies only to the code released by the
-;; Free Software Foundation under the name GUILE.  If you copy
+;; Free Software Foundation under the name SCM.  If you copy
 ;; code from other Free Software Foundation releases into a copy of
-;; GUILE, as the General Public License permits, the exception does
+;; SCM, as the General Public License permits, the exception does
 ;; not apply to the code that you add in this way.  To avoid misleading
 ;; anyone as to the status of such modified files, you must delete
 ;; this exception notice from them.
 ;;
-;; If you write modifications of your own for GUILE, it is your choice
+;; If you write modifications of your own for SCM, it is your choice
 ;; whether to permit this exception to apply to your modifications.
 ;; If you do not wish that, delete this exception notice.
 
@@ -44,8 +44,9 @@
 ;;; Author: Aubrey Jaffer.
 
 (define (go-script)
-  (cond ((not *script*))
+  (cond ;;((not *script*))
 	((>= 1 (- (length *argv*) *optind*))
+	 (xatoms)
 	 (apply xgen.scm (list-tail *argv* *optind*)))
 	(else
 	 (display "\
@@ -60,28 +61,14 @@ Usage: xgen.scm /usr/include/X11/Xlib.h
 
 (require 'common-list-functions)
 (require 'string-search)
+(require 'string-case)
 (require 'line-i/o)
 (require 'printf)
 (require 'scanf)
 
-(define (StudlyCaps->dashed-name nstr)
-  (do ((idx (+ -1 (string-length nstr)) (+ -1 idx)))
-      ((> 2 idx))
-    (cond ((and (char-upper-case? (string-ref nstr (+ -1 idx)))
-		(char-lower-case? (string-ref nstr idx)))
-	   (set! nstr
-		 (string-append (substring nstr 0 (+ -1 idx))
-				"-"
-				(substring nstr (+ -1 idx)
-					   (string-length nstr)))))
-	  ((and (char-lower-case? (string-ref nstr (+ -1 idx)))
-		(char-upper-case? (string-ref nstr idx)))
-	   (set! nstr
-		 (string-append (substring nstr 0 idx)
-				"-"
-				(substring nstr idx
-					   (string-length nstr)))))))
-  nstr)
+(define progname (if (defined? *optind*)
+		     (list-ref *argv* (+ -1 *optind*))
+		     (car (program-arguments))))
 
 ;; SCHEMEIFY-NAME:
 ;; * Changes _ to -
@@ -93,8 +80,8 @@ Usage: xgen.scm /usr/include/X11/Xlib.h
   (let ((sid (string-index nstr #\-)))
     (cond ((and pre sid (< sid 3)) (string-set! nstr sid #\:)
 	   nstr)
-	  (pre (string-append pre (StudlyCaps->dashed-name nstr)))
-	  (else (StudlyCaps->dashed-name nstr)))))
+	  (pre (string-append pre (StudlyCapsExpand nstr)))
+	  (else (StudlyCapsExpand nstr)))))
 
 (define (extract-structs port)
   (define typedef-struct (string-append (string #\newline) "typedef struct {"))
@@ -241,54 +228,91 @@ Usage: xgen.scm /usr/include/X11/Xlib.h
   (let ((structs (remove-if-not
 		  (lambda (struct) (substring? "Event" (car struct)))
 		  (call-with-input-file filename extract-structs))))
-    (call-with-output-file "xevent.h"
-      (lambda (xevent.h)
-	(fprintf xevent.h "/* %s extracted typedef structs from %s */\n"
-		 (car *argv*) filename)
-	(fprintf xevent.h
-		 "#ifdef SCM_EVENT_FIELDS\n")
-	(call-with-output-file "xevent.scm"
-	  (lambda (xevent.scm)
-	    (define evs #f)
-	    (fprintf xevent.scm ";; %s extracted typedef structs from %s\n"
-		     (car *argv*) filename)
-	    (for-each
-	     (lambda (struct)
-	       (define name (car struct))
-	       (set! evs (assoc name event-map))
-	       (and
-		evs
-		(for-each
-		 (lambda (decl)
-		   (define typ (string->symbol (car decl)))
-		   (casev typ
-		     ((,Bool ,Time int char)
-		      (fprintf xevent.h "  ")
-		      (for-each (lambda (event-name)
-				  (fprintf xevent.h "case (%s<<8)+0x%02x: "
-					   event-name
-					   (do-field xevent.scm (cadr decl))))
-				(cdr evs))
-		      (fprintf xevent.h "return %s(((%s *) x)->%s);\n"
-			       (casev typ
-				 ((,Bool) "x_make_bool")
-				 ((,Time) "ulong2num")
-				 ((int char) "MAKINUM"))
-			       name
-			       (cadr decl)))
-		     ;;(else (print 'typ typ))
-		     ))
-		 (cdr struct))))
-	     structs)))
-	(fprintf xevent.h "#else\n")
-	(for-each (lambda (apr)
-		    (for-each (lambda (evnt)
-				(fprintf xevent.h
-					 "  {%-20s \"%s\"},\n"
-					 (string-append evnt ",") evnt))
-			      (cdr apr)))
-		  event-map)
-	(fprintf xevent.h "#endif\n")))))
+    (call-with-open-ports
+     (open-file "xevent.h" "w")
+     (open-file "xevent.scm" "w")
+     (lambda (xevent.h xevent.scm)
+       (define evs #f)
+       (fprintf xevent.h "/* %s extracted typedef structs from %s */\n"
+		progname filename)
+       (fprintf xevent.h
+		"#ifdef SCM_EVENT_FIELDS\n")
+       (fprintf xevent.scm ";; %s extracted typedef structs from %s\n"
+		progname filename)
+       (for-each
+	(lambda (struct)
+	  (define name (car struct))
+	  (set! evs (assoc name event-map))
+	  (and
+	   evs
+	   (for-each
+	    (lambda (decl)
+	      (define typ (string->symbol (car decl)))
+	      (qase typ
+		((,Bool ,Time int char)
+		 (fprintf xevent.h "  ")
+		 (for-each (lambda (event-name)
+			     (fprintf xevent.h "case (%s<<8)+0x%02x: "
+				      event-name
+				      (do-field xevent.scm (cadr decl))))
+			   (cdr evs))
+		 (fprintf xevent.h "return %s(((%s *) x)->%s);\n"
+			  (qase typ
+			    ((,Bool) "x_make_bool")
+			    ((,Time) "ulong2num")
+			    ((int char) "MAKINUM"))
+			  name
+			  (cadr decl)))
+		;;(else (print 'typ typ))
+		))
+	    (cdr struct))))
+	structs)
+       (fprintf xevent.h "#else\n")
+       (for-each (lambda (apr)
+		   (for-each (lambda (evnt)
+			       (fprintf xevent.h
+					"  {%-20s \"%s\"},\n"
+					(string-append evnt ",") evnt))
+			     (cdr apr)))
+		 event-map)
+       (fprintf xevent.h "#endif\n")))))
+
+(define (xatoms)
+  (define /usr/include/X11/Xatom.h "/usr/include/X11/Xatom.h")
+  (define /usr/include/X11/Xcms.h "/usr/include/X11/Xcms.h")
+  (call-with-open-ports
+   (open-file /usr/include/X11/Xatom.h "r")
+   (open-file "/usr/include/X11/Xcms.h" "r")
+   (open-file "xatoms.scm" "w")
+   (lambda (xatom.h xcms.h xatoms.scm)
+     (fprintf xatoms.scm ";; %s extracted definitions from %s\n"
+	      progname /usr/include/X11/Xatom.h)
+     (do ((line (read-line xatom.h) (read-line xatom.h)))
+	 ((eof-object? line))
+       (let ((lst (scanf-read-list "#define XA_%s ((Atom) %d)" line)))
+	 (and (list? lst)
+	      (case (length lst)
+		((2) (fprintf xatoms.scm "(define %s %d)\n"
+			      (string-subst (car lst) "_" "-")
+			      (cadr lst)))
+		((0) #f)		;(write-line line)
+		(else (slib:error 'xatom.h 'line line))))))
+     (fprintf xatoms.scm ";; %s extracted definitions from %s\n"
+	      progname /usr/include/X11/Xcms.h)
+     (do ((line (read-line xcms.h) (read-line xcms.h)))
+	 ((eof-object? line))
+       (let ((lst (scanf-read-list "#define Xcms%s (XcmsColorFormat)0x%4x%4x"
+				   line)))
+	 (and (list? lst)
+	      (case (length lst)
+		((3) (apply fprintf xatoms.scm "(define\tX:%s\t#x%04x%04x)\n"
+			    (string-subst (car lst) "Format" "")
+			    (cdr lst)))
+		((2) (fprintf xatoms.scm "(define\tX:%s\t#x%08x)\n"
+			      (string-subst (car lst) "Format" "")
+			      (cadr lst)))
+		((0 1) #f)
+		(else (slib:error 'xcms.h 'line line)))))))))
 
 (go-script)