Last active
February 4, 2017 08:31
-
-
Save killdash9/faa93a382f18dd8952a60c036a715ea1 to your computer and use it in GitHub Desktop.
When emacs advice is not enough. Redefine builtin functions using search and replace.
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(defun patch-function (func-symbol regexp rep) | |
"Redefine the function given by FUNC-SYMBOL by replacing all | |
occurrences of REGEXP with REP in its source definition. The | |
function is evaluated with the changes and then reverted to its | |
original form so that the original source code file is left | |
unmodifed. This makes `patch-function' idempotent. | |
REGEXP is a regular expression to search for in FUNC-SYMBOL's | |
definition. | |
REP is the replacement text. It can be a string or a form. If | |
REP is a non-string form, it gets converted to a string with | |
`pp-to-string' before the replacement. This allows you to code | |
the replacement form without having to surround it with quotes. | |
If your replacement is an unbalanced form, you will have to pass | |
it in as a string. | |
Examples: | |
Here's an invocation with a form replacement. | |
;; Make the attach function tell me the name of the existing | |
;; mail buffer which the file will be attached. | |
(require 'gnus-dired) | |
(patch-function 'gnus-dired-attach | |
\"\\\"Attach files to existing mail composition buffer\\\\? \\\"\" | |
'(format \"Attach files to existing mail composition buffer%s\" | |
(if (= (length bufs) 1) | |
(concat \" (\" (car bufs) \")?\") | |
\"?\"))) | |
And here's an invocation with a string replacement. | |
;; Make tramp shell prompt show my current directory | |
(patch-function | |
'tramp-sh-handle-start-file-process | |
\"(tramp-file-name-localname v)\" | |
\"\\\"$PWD\\\"\") | |
" | |
(let ((buffer-list (buffer-list)) | |
(rep (if (stringp rep) rep (pp-to-string rep)))) ;; convert to string | |
(cl-destructuring-bind (buf . point) (find-function-noselect func-symbol t) | |
(with-current-buffer buf ;; temporarily switch to buffer | |
;; create an empty undo stack so that we can revert changes below | |
(let ((buffer-undo-list)) | |
(save-mark-and-excursion ;; save point and mark | |
(unwind-protect | |
(progn | |
(narrow-to-defun) | |
;; search and replace | |
(re-search-forward regexp) | |
(cl-loop do (replace-match rep) | |
while (re-search-forward regexp nil t)) | |
;; evaluate the narrowed buffer | |
(eval-buffer)) | |
(widen) | |
;; undo just our changes | |
(primitive-undo (length buffer-undo-list) buffer-undo-list))) | |
;; kill the buffer unless it was already open | |
(unless (member buf buffer-list) (kill-buffer)))))) | |
(message "Patched function %s" func-symbol)) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment