0
|
1 ;; Universal (?) replace comment in function
|
|
2
|
|
3 ;; Last edited: Thu Oct 7 09:39:50 1993
|
|
4 (defun repl-comment (fn comment)
|
|
5 "replace/install as FN's comment COMMENT, no matter what emacs/compiler"
|
|
6 (let ((defn (symbol-function fn)))
|
|
7 (if (consp defn)
|
|
8 (if (eq (car defn) 'autoload)
|
|
9 (progn (load-library (car (cdr defn)))
|
|
10 (if (equal defn (symbol-function fn))
|
|
11 (error "autoloading didn't help define %s" fn)
|
|
12 (repl-comment fn comment)))
|
|
13 ;; either symbolic or old byte-compiler
|
|
14 (if (eq (car defn) 'lambda)
|
|
15 (if (stringp (car (cdr (cdr defn))))
|
|
16 (rplaca (cdr (cdr defn))
|
|
17 comment)
|
|
18 (rplacd (cdr defn)
|
|
19 (cons comment
|
|
20 (cdr (cdr defn)))))
|
|
21 (error "can't diagnose defn %s" defn)))
|
|
22 ;; array or not
|
|
23 (if (compiled-function-p defn)
|
|
24 (fset fn (repl-byte fn (list (cons 4 comment))))
|
|
25 (error "unrecognised defn %s" defn)))))
|
|
26
|
|
27 (defun repl-byte (fn alist)
|
|
28 "compute a new byte-code defn for FN, replacing
|
|
29 elements using ALIST, which is interpreted as (index . newbit).
|
|
30 Elements are 0: arglist 1: byte-codes 2: symbols 3: stack-depth 4: comment"
|
|
31 (let
|
|
32 ((defn (symbol-function fn)))
|
|
33 (let ((ln (if (sequencep defn)
|
|
34 (length defn)
|
|
35 ;; hack otherwise
|
|
36 6))
|
|
37 (i 0)
|
|
38 new entry)
|
|
39 (apply (function make-byte-code)
|
|
40 (progn (while (< i ln)
|
|
41 (setq new
|
|
42 (cons
|
|
43 (if (setq entry (assoc i alist))
|
|
44 (cdr entry)
|
|
45 (aref defn i))
|
|
46 new))
|
|
47 (setq i (1+ i)))
|
|
48 (nreverse new))))))
|
|
49
|
|
50
|
|
51 (provide 'repl-comment)
|