;; Universal (?) replace comment in function

;; Last edited: Thu Oct  7 09:39:50 1993
(defun repl-comment (fn comment)
  "replace/install as FN's comment COMMENT, no matter what emacs/compiler"
  (let ((defn (symbol-function fn)))
    (if (consp defn)
	(if (eq (car defn) 'autoload)
	    (progn (load-library (car (cdr defn)))
		   (if (equal defn (symbol-function fn))
		       (error "autoloading didn't help define %s" fn)
		     (repl-comment fn comment)))
	  ;; either symbolic or old byte-compiler
	  (if (eq (car defn) 'lambda)
	      (if (stringp (car (cdr (cdr defn))))
		  (rplaca (cdr (cdr defn))
			  comment)
		(rplacd (cdr defn)
			(cons comment
			      (cdr (cdr defn)))))
	    (error "can't diagnose defn %s" defn)))
      ;; array or not
      (if (compiled-function-p defn)
	  (fset fn (if (fboundp 'compiled-function-arglist)
		  (progn     (make-byte-code
			(compiled-function-arglist defn)
			(compiled-function-instructions defn)
			(compiled-function-constants defn)
			(compiled-function-stack-depth defn)
			comment
			(compiled-function-interactive defn)) defn)
		     (repl-byte fn (list (cons 4 comment)))))
	(error "unrecognised defn %s" defn)))))

(defun repl-byte (fn alist)
  "compute a new byte-code defn for FN, replacing
elements using ALIST, which is interpreted as (index . newbit).
Elements are 0: arglist 1: byte-codes 2: symbols 3: stack-depth 4: comment"
  (let
      ((defn (symbol-function fn)))
    (let ((ln (if (sequencep defn)
		  (length defn)
		;; hack otherwise
		6))
	  (i 0)
	  new entry)
      (apply (function make-byte-code)
	     (progn (while (< i ln)
		      (setq new
			    (cons
			     (if (setq entry (assoc i alist))
				 (cdr entry)
			       (aref defn i))
			     new))
		      (setq i (1+ i)))
		    (nreverse new))))))


(provide 'repl-comment)