Mercurial > hg > xemacs-beta
diff lisp/hyperbole/hypb.el @ 171:929b76928fce r20-3b12
Import from CVS: tag r20-3b12
author | cvs |
---|---|
date | Mon, 13 Aug 2007 09:47:52 +0200 |
parents | cf808b4c4290 |
children |
line wrap: on
line diff
--- a/lisp/hyperbole/hypb.el Mon Aug 13 09:47:00 2007 +0200 +++ b/lisp/hyperbole/hypb.el Mon Aug 13 09:47:52 2007 +0200 @@ -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