From xemacs-m  Tue Jul  8 02:23:42 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 CAA18071
	for <xemacs-beta@xemacs.org>; Tue, 8 Jul 1997 02:23:41 -0500 (CDT)
Received: (from steve@localhost)
	by altair.xemacs.org (8.8.6/8.8.6) id AAA03927;
	Tue, 8 Jul 1997 00:26:29 -0700
Mail-Copies-To: never
To: xemacs-beta@xemacs.org
Cc: weiner@altrasoft.com
Subject: [PATCH] LOSING_BYTECODE fixes for hyperbole & oobr
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@xemacs.org>
Mime-Version: 1.0 (generated by tm-edit 7.108)
Content-Type: text/plain; charset=US-ASCII
Date: 08 Jul 1997 00:26:28 -0700
Message-ID: <m24ta62ee3.fsf@altair.xemacs.org>
Lines: 133
X-Mailer: Gnus v5.4.62/XEmacs 20.3(beta12) - "Helsinki"

Bob, there's no necessity to get these patches into InfoDock 4.0.

As far as I know, we now have patches in place for all the places
where LOSING_BYTECODE was being used.

1997-07-07  Steven L Baur  <steve@altair.xemacs.org>

	* oobr/br-clos-ft.el (clos-scan-routine-arglist): Don't reference
	bytecode object as vector.

	* hypberbole/hact.el (action:commandp): Don't reference bytecode
	objects as vectors.
	(action:params): Ditto.
	
	* hyperbole/hypb.el (hypb:function-copy): Don't reference byte
	code objects as vectors.
	(hypb:function-symbol-replace): Document as broken.  The
	substition cannot be done without some thinking I'm not in the
	mood for.

Index: lisp/oobr/br-clos-ft.el
===================================================================
RCS file: /usr/local/xemacs/xemacs-20.0/lisp/oobr/br-clos-ft.el,v
retrieving revision 1.2
diff -u -r1.2 br-clos-ft.el
--- br-clos-ft.el	1997/02/24 01:13:48	1.2
+++ br-clos-ft.el	1997/07/08 07:10:29
@@ -238,8 +238,10 @@
 				  'compiled-function-p
 				'byte-code-function-p)
 			      aliased-function)
-		     ;; Turn into a list for extraction
-		     (car (cdr (cons nil (append aliased-function nil)))))))
+		     (if (fboundp 'compiled-function-arglist)
+			 (compiled-function-arglist aliased-function)
+		       ;; Turn into a list for extraction
+		       (car (cdr (cons nil (append aliased-function nil))))))))
 	(if arg-list (prin1-to-string arg-list))))))
 
 (defun clos-sort-features (feature-list)


Index: lisp/hyperbole/hact.el
===================================================================
RCS file: /usr/local/xemacs/xemacs-20.0/lisp/hyperbole/hact.el,v
retrieving revision 1.1.1.1
diff -u -r1.1.1.1 hact.el
--- hact.el	1996/12/18 22:43:15	1.1.1.1
+++ hact.el	1997/07/08 07:05:24
@@ -55,8 +55,10 @@
 		(error "(action:commandp): Autoload not supported: %s" function))
 	       (t function))))
     (if (hypb:v19-byte-code-p action)
-	(if (commandp action)
-	    (list 'interactive (aref action 5)))
+	(cond ((fboundp 'compiled-function-interactive)
+	       (compiled-function-interactive action))
+	      ((commandp action)
+	       (list 'interactive (aref action 5))))
       (commandp action))))
 
 (defun action:create (param-list body)
@@ -80,8 +82,10 @@
 	     (error "(action:params): Autoload not supported: %s" action)
 	   (car (cdr action))))
 	((hypb:v19-byte-code-p action)
-	 ;; Turn into a list for extraction
-	 (car (cdr (cons nil (append action nil)))))))
+	 (if (fboundp 'compiled-function-arglist)
+	     (compiled-function-arglist action)
+	   ;; Turn into a list for extraction
+	   (car (cdr (cons nil (append action nil))))))))
 
 (defun action:param-list (action)
   "Returns list of actual ACTION parameters (removes '&' special forms)."


Index: lisp/hyperbole/hypb.el
===================================================================
RCS file: /usr/local/xemacs/xemacs-20.0/lisp/hyperbole/hypb.el,v
retrieving revision 1.3
diff -u -r1.3 hypb.el
--- hypb.el	1997/03/04 02:29:44	1.3
+++ hypb.el	1997/07/08 06:54:13
@@ -227,8 +227,22 @@
 	      ((subrp func) (error "(hypb:function-copy): `%s' is a primitive; can't copy body."
 				   func-symbol))
 	      ((and (hypb:v19-byte-code-p func) (fboundp 'make-byte-code))
-	       (let ((new-code (append func nil))) ; turn it into a list
-		 (apply 'make-byte-code new-code)))
+	       (if (not (fboundp 'compiled-function-arglist))
+		   ;; This is evil -slb
+		   (let ((new-code (append func nil))) ; turn it into a list
+		     (apply 'make-byte-code new-code))
+		 ;; Can't reference bytecode objects as vectors in modern
+		 ;; XEmacs.
+		 (let ((new-code (nconc
+				  (list (compiled-function-arglist func)
+					(compiled-function-instructions func)
+					(compiled-function-constants func)
+					(compiled-function-stack-depth func)
+					(compiled-function-doc-string func))))
+		       spec)
+		   (if (setq spec (compiled-function-interactive func))
+		       (setq new-code (nconc new-code (list (nth 1 spec)))))
+		   (apply 'make-byte-code new-code))))
 	      (t (error "(hypb:function-copy): Can't copy function body: %s" func))
 	      ))
     (error "(hypb:function-copy): `%s' symbol is not bound to a function."
@@ -261,6 +275,7 @@
 		  (append new-forms old-func-call)
 		(append old-func-call new-forms)))))))
 
+;; #### FIXME -- This code is highly broken in XEmacs 20.3
 (defun hypb:function-symbol-replace (func-sym sym-to-replace replace-with-sym)
   "Replaces in body of FUNC-SYM SYM-TO-REPLACE with REPLACE-WITH-SYM.
 All occurrences within lists are replaced.  Returns body of modified FUNC-SYM."
@@ -277,7 +292,9 @@
 					arg-vector)))
 			       body))))
       ;; assume V19 byte compiler   (eq (compiled-function-p body) t)
-      (setq arg (aref body 2)
+      (setq arg (if (fboundp 'compiled-function-arglist)
+		    (compiled-function-arglist body)
+		  (aref body 2))
 	    arg-vector (if (vectorp arg) arg))
       )
     (if arg-vector


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

