annotate emacs/repl-comment.el @ 13:1cd5c7952aaa default tip

fix failure to read first line of Air/Lava, keep me from swimming in Lava, again!
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Sun, 30 Jan 2022 14:49:33 -0500
parents 509549c55989
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
1 ;; Universal (?) replace comment in function
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
2
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
3 ;; Last edited: Thu Oct 7 09:39:50 1993
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
4 (defun repl-comment (fn comment)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
5 "replace/install as FN's comment COMMENT, no matter what emacs/compiler"
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
6 (let ((defn (symbol-function fn)))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
7 (if (consp defn)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
8 (if (eq (car defn) 'autoload)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
9 (progn (load-library (car (cdr defn)))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
10 (if (equal defn (symbol-function fn))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
11 (error "autoloading didn't help define %s" fn)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
12 (repl-comment fn comment)))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
13 ;; either symbolic or old byte-compiler
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
14 (if (eq (car defn) 'lambda)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
15 (if (stringp (car (cdr (cdr defn))))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
16 (rplaca (cdr (cdr defn))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
17 comment)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
18 (rplacd (cdr defn)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
19 (cons comment
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
20 (cdr (cdr defn)))))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
21 (error "can't diagnose defn %s" defn)))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
22 ;; array or not
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
23 (if (compiled-function-p defn)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
24 (fset fn (repl-byte fn (list (cons 4 comment))))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
25 (error "unrecognised defn %s" defn)))))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
26
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
27 (defun repl-byte (fn alist)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
28 "compute a new byte-code defn for FN, replacing
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
29 elements using ALIST, which is interpreted as (index . newbit).
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
30 Elements are 0: arglist 1: byte-codes 2: symbols 3: stack-depth 4: comment"
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
31 (let
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
32 ((defn (symbol-function fn)))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
33 (let ((ln (if (sequencep defn)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
34 (length defn)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
35 ;; hack otherwise
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
36 6))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
37 (i 0)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
38 new entry)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
39 (apply (function make-byte-code)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
40 (progn (while (< i ln)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
41 (setq new
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
42 (cons
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
43 (if (setq entry (assoc i alist))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
44 (cdr entry)
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
45 (aref defn i))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
46 new))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
47 (setq i (1+ i)))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
48 (nreverse new))))))
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
49
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
50
509549c55989 from elsewhere
Henry S. Thompson <ht@inf.ed.ac.uk>
parents:
diff changeset
51 (provide 'repl-comment)