Mercurial > hg > lib > markup

comparison emacs/repl-comment.el @ 0:509549c55989

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
from elsewhere
author Henry S. Thompson <ht@inf.ed.ac.uk>
date Tue, 25 May 2021 13:57:42 -0400
parents
children
comparison
equal deleted inserted replaced
-1:000000000000 0:509549c55989
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)