From xemacs-m  Wed Apr 30 17:06:17 1997
Received: from altair.xemacs.org (steve@xemacs.miranova.com [206.190.83.19])
	by xemacs.org (8.8.5/8.8.5) with ESMTP id RAA13308
	for <xemacs-beta@xemacs.org>; Wed, 30 Apr 1997 17:06:16 -0500 (CDT)
Received: (from steve@localhost)
	by altair.xemacs.org (8.8.5/8.8.5) id PAA25289;
	Wed, 30 Apr 1997 15:07:54 -0700
Mail-Copies-To: never
To: xemacs-beta@xemacs.org
Subject: Experimental #-, #+ reader syntax patch
X-Url: http://www.miranova.com/%7Esteve/
X-Face: #!T9!#9s-3o8)*uHlX{Ug[xW7E7Wr!*L46-OxqMu\xz23v|R9q}lH?cRS{rCNe^'[`^sr5"
 f8*@r4ipO6Jl!:Ccq<xoV[Qz2u8<8-+Vwf2gzJ44lf_/y9OaQ`@#Q65{U4/TC)i2`~/M&QI$X>p:9I
 OSS'2{-)-4wBnVeg0S\O4Al@)uC[pD|+
X-Attribution: sb
From: Steven L Baur <steve@miranova.com>
Mime-Version: 1.0 (generated by tm-edit 7.106)
Content-Type: multipart/mixed;
 boundary="Multipart_Wed_Apr_30_15:07:51_1997-1"
Content-Transfer-Encoding: 7bit
Date: 30 Apr 1997 15:07:51 -0700
Message-ID: <m2bu6wqi4o.fsf@altair.xemacs.org>
Lines: 259
X-Mailer: Gnus v5.4.48/XEmacs 20.2(beta4)

--Multipart_Wed_Apr_30_15:07:51_1997-1
Content-Type: text/plain; charset=US-ASCII

In case anyone wants to play with this on XEmacs ...


--Multipart_Wed_Apr_30_15:07:51_1997-1
Content-Type: application/octet-stream; type=emacs-lisp
Content-Disposition: attachment; filename="featurep.el"
Content-Transfer-Encoding: 7bit

;;; featurep.el --- Support functions for reader conditionals

;; Copyright 1997 Naggum Software

;; Author: Erik Naggum <erik@naggum.no>
;; Keywords: internal

;; This file is not (yet) part of GNU Emacs, but distributed under the
;; same conditions as GNU Emacs, and is useless without GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
;; Boston, MA 02111-1307, USA.

;;; Commentary:

;; The #+ and #- reader macros require support code to work properly until
;; `featurep' is enhanced in the C code.  This support code is written in
;; Lisp to make it easier to experiment with the code.

;;; Code:

(eval-when-compile (require 'cl))

(provide (if (string-match "XEmacs" emacs-version) 'xemacs 'emacs))

(defvar featurep-emacs-version nil
  "The version number of this Emacs, as a floating-point number.")

(defun featurep (fexp)
  "Return non-nil if feature expression FEXP is true."
  (typecase fexp
    (symbol (memq fexp features))       ;original definition
    (number (>= (or featurep-emacs-version
                    (setq featurep-emacs-version
                      (+ emacs-major-version
                         (/ emacs-minor-version 100.0))))
                fexp))
    (list (case (pop fexp)
            (not (let ((negate (pop fexp)))
                   (if fexp
                     (signal 'invalid-read-syntax (list fexp))
                     (not (featurep negate)))))
            (and (while (and fexp (featurep (car fexp)))
                   (pop fexp))
                 (null fexp))
            (or (while (and fexp (not (featurep (car fexp))))
                  (pop fexp))
                fexp)
            (t (signal 'invalid-read-syntax (list fexp)))))
    (t (signal 'invalid-read-syntax (list fexp)))))

;;; featurep.el ends here


--Multipart_Wed_Apr_30_15:07:51_1997-1
Content-Type: text/plain; charset=US-ASCII

Index: src/Makefile.in.in
===================================================================
RCS file: /usr/local/xemacs/xemacs-20.0/src/Makefile.in.in,v
retrieving revision 1.21
diff -u -r1.21 Makefile.in.in
--- Makefile.in.in	1997/04/24 04:00:43	1.21
+++ Makefile.in.in	1997/04/30 21:47:02
@@ -1199,7 +1199,7 @@
     here because we do not want things to appear to be out-of-date just 
     because the version number has been incremented. -- D.N.G. 8/28/93]
  */
-lisp=   ${lispdir}paths.el \
+lisp=   ${lispdir}paths.el ${lispdir}prim/featurep.elc \
 	${lispdir}prim/loaddefs.elc ${lispdir}prim/auto-autoloads.elc \
         ${lispdir}prim/loadup.el ${lispdir}prim/subr.elc \
         ${lispdir}prim/cmdloop.elc CMDLOOP_LISP \

Index: lisp/prim/loadup.el
===================================================================
RCS file: /usr/local/xemacs/xemacs-20.0/lisp/prim/loadup.el,v
retrieving revision 1.8
diff -u -r1.8 loadup.el
--- loadup.el	1997/04/13 03:14:13	1.8
+++ loadup.el	1997/04/30 21:43:21
@@ -78,6 +78,7 @@
      (load-gc "replace") 		; match-string used in version.el.
      (load-gc "version.el")		; Ignore compiled-by-mistake version.elc
      (load-gc "cl")
+     (load-gc "featurep")
      (load-gc "widget")
      (load-gc "custom") ; Before the world so everything can be customized
      (load-gc "cus-start") ; for customization of builtin variables

Index: lisp/version.el
===================================================================
RCS file: /usr/local/xemacs/xemacs-20.0/lisp/version.el,v
retrieving revision 1.28
diff -u -r1.28 version.el
--- version.el	1997/04/27 19:29:58	1.28
+++ version.el	1997/04/27 23:51:03
@@ -61,7 +61,10 @@
 	  "XEmacs %s [Lucid] (%s%s) of %s %s on %s"
 	  (substring emacs-version 0 (string-match " XEmacs" emacs-version))
 	  system-configuration
-	  (cond ((featurep 'mule) ", Mule") (t ""))
+	  (cond ((or (and (fboundp 'featurep)
+			  (featurep 'mule))
+		     (memq 'mule features)) ", Mule")
+		(t ""))
 	  (substring emacs-build-time 0
 		     (string-match " *[0-9]*:" emacs-build-time))
 	  (substring emacs-build-time

Index: src/lread.c
===================================================================
RCS file: /usr/local/xemacs/xemacs-20.0/src/lread.c,v
retrieving revision 1.7
diff -u -r1.7 lread.c
--- lread.c	1997/04/05 18:08:38	1.7
+++ lread.c	1997/04/30 21:56:27
@@ -73,6 +73,13 @@
 
 int puke_on_fsf_keys;
 
+/* This symbol is also used in fns.c */
+#define FEATUREP_SYNTAX
+
+#ifdef FEATUREP_SYNTAX
+static Lisp_Object Qfeaturep;
+#endif
+
 /* non-zero if inside `load' */
 int load_in_progress;
 
@@ -2369,7 +2376,26 @@
 	      return Fsignal (Qinvalid_read_syntax,
 		    list1 (build_string ("Cannot read unreadable object")));
 	    }
+#ifdef FEATUREP_SYNTAX
+	  case '+':
+	  case '-':
+	    {
+	      Lisp_Object fexp, obj, tem;
+	      struct gcpro gcpro1, gcpro2;
 
+	      fexp = read0(readcharfun);
+	      obj = read0(readcharfun);
+
+	      /* the call to `featurep' may GC. */
+	      GCPRO2(fexp, obj);
+	      tem = call1(Qfeaturep, fexp);
+	      UNGCPRO;
+
+	      if (c == '+' && NILP(tem)) goto retry;
+	      if (c == '-' && !NILP(tem)) goto retry;
+	      return obj;
+	    }
+#endif
 	  default:
 	    {
 	      unreadchar (readcharfun, c);
@@ -2618,6 +2644,14 @@
       free_cons (XCONS (tem));
       tem = Qnil;
       ch = XCHAR (elt);
+#ifdef FEATUREP_SYNTAX
+      if (ch == s->terminator) /* deal with possible atom deletion */
+	{
+	  unreadchar (readcharfun, s->terminator);
+	  goto done;
+	}
+      else
+#endif
       if (ch != '.')
 	signal_simple_error ("BUG! Internal reader error", elt);
       else if (!s->allow_dotted_lists)
@@ -3129,6 +3163,12 @@
 
   /* So that early-early stuff will work */
   Ffset (Qload, intern ("load-internal"));
+
+#ifdef FEATUREP_SYNTAX
+  Qfeaturep = intern("featurep");
+  staticpro(&Qfeaturep);
+  Fprovide(intern("xemacs"));
+#endif
 
 #ifdef LISP_BACKQUOTES
   old_backquote_flag = new_backquote_flag = 0;

Index: src/fns.c
===================================================================
RCS file: /usr/local/xemacs/xemacs-20.0/src/fns.c,v
retrieving revision 1.5
diff -u -r1.5 fns.c
--- fns.c	1997/04/10 05:56:42	1.5
+++ fns.c	1997/04/30 21:45:11
@@ -45,6 +45,9 @@
 #include "frame.h"
 #include "systime.h"
 
+/* NOTE: This symbol is also used in lread.c */
+#define FEATUREP_SYNTAX
+
 Lisp_Object Qstring_lessp;
 Lisp_Object Qidentity;
 
@@ -3320,6 +3323,7 @@
 
 Lisp_Object Vfeatures;
 
+#ifndef FEATUREP_SYNTAX
 DEFUN ("featurep", Ffeaturep, 1, 1, 0, /*
 Return t if FEATURE is present in this Emacs.
 Use this to conditionalize execution of lisp code based on the
@@ -3332,6 +3336,7 @@
   CHECK_SYMBOL (feature);
   return NILP (Fmemq (feature, Vfeatures)) ? Qnil : Qt;
 }
+#endif
 
 DEFUN ("provide", Fprovide, 1, 1, 0, /*
 Announce that FEATURE is a feature of the current Emacs.
@@ -3467,7 +3472,9 @@
   DEFSUBR (Fmapc_internal);
   DEFSUBR (Fmapconcat);
   DEFSUBR (Fload_average);
+#ifndef FEATUREP_SYNTAX
   DEFSUBR (Ffeaturep);
+#endif
   DEFSUBR (Frequire);
   DEFSUBR (Fprovide);
 }

-- 
steve@miranova.com baur
Unsolicited commercial e-mail will be billed at $250/message.

--Multipart_Wed_Apr_30_15:07:51_1997-1--

