Mercurial > hg > lib > markup
view emacs/repl-comment.el @ 0:509549c55989
from elsewhere
author | Henry S. Thompson <ht@inf.ed.ac.uk> |
---|---|
date | Tue, 25 May 2021 13:57:42 -0400 |
parents | |
children |
line wrap: on
line source
;; 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 (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)