Change expression in body of elisp function with advice - emacs

How do you match a specific expression in the body on elisp function when adding advice? Specifically, in the following example, I would like to advise the function to use find-file-noselect in place of find-file, ie.
the line (find-file path) would be in effect (find-file-noselect path).
(defun tst-fun (path line column)
(find-file path)
(goto-char (point-min))
(forward-line (1- line))
(forward-char column))
;; not sure how to structure this
(defadvice tst-fun (around noselect activate)
(find-file-noselect (ad-get-arg 0))
ad-do-it)
I would rather have it as ad-add-function, but am trying to just get this working first.

You could temporarily redefine find-file as find-file-noselect in the advice.
(require 'cl)
(defadvice tst-fun (around noselect activate)
(flet ((find-file (&rest args)
(apply 'find-file-noselect args)))
ad-do-it))

Related

How to change the behaviour of org-agenda-goto to open org-file in a new frame?

When pressing TAB (org-agenda-goto) in org-agenda I want to open the related org-file in a new frame instead of splitting the existing frame.
I could create a modified function of org-agenda-goto replacing switch-to-buffer-other-window with switch-to-buffer-other-frame and rebinding the TAB-key but I assume there is a more elegant way to do so?
The quick solution would be as below modifying line 8:
(defun sk/org-agenda-goto (&optional highlight)
"Go to the entry at point in the corresponding Org file."
(interactive)
(let* ((marker (or (org-get-at-bol 'org-marker)
(org-agenda-error)))
(buffer (marker-buffer marker))
(pos (marker-position marker)))
(switch-to-buffer-other-frame buffer)
(widen)
(push-mark)
(goto-char pos)
(when (derived-mode-p 'org-mode)
(org-show-context 'agenda)
(recenter (/ (window-height) 2))
(org-back-to-heading t)
(let ((case-fold-search nil))
(when (re-search-forward org-complex-heading-regexp nil t)
(goto-char (match-beginning 4)))))
(run-hooks 'org-agenda-after-show-hook)
(and highlight (org-highlight (point-at-bol) (point-at-eol)))))
I assume it may be done more elegantly with advice but I'm not so experienced in emacs-lisp and would not know how exactly this could be achived or if using advice would be the right approach.
I found out in override prefered method are hints for using advice-add like this in order to replace the original function with my own:
(advice-add 'org-agenda-goto :override #'sk/org-agenda-goto)
You can use advice to temporarily redefine switch-to-buffer-other-window using cl-letf. Assuming your on at least emacs 25.1 you can use define-advice, eg.
(define-advice org-agenda-goto (:around (orig-fn &rest args) "new-frame")
(cl-letf (((symbol-function 'switch-to-buffer-other-window)
(symbol-function 'switch-to-buffer-other-frame)))
(apply orig-fn args)))
In the advice orig-fn is a placeholder to org-agenda-goto. Alternatively, you could temporarily override display-buffer's function (there are a number of options you could use here -- see help for display-buffer), eg.
(define-advice org-agenda-goto (:around (orig-fn &rest args) "new-frame")
(let ((display-buffer-overriding-action '(display-buffer-pop-up-frame)))
(apply orig-fn args)))

A Simple 'copy-form Command

I want a command that copies a form to the kill ring. In emacs-live, the closest thing I could find was this command / key-binding
(global-set-key (kbd "M-]") 'kill-ring-save)
However kill-ring-save has some wonky behaviour. Ii copies more than 1 form, past the cursor. Ultimately, I want a simple function along the lines of what's below (this doesn't quite work).
(defun copy-form ()
(kill-ring-save (line-beginning-position) (live-paredit-forward)))
(global-set-key (kbd "M-]") 'copy-form)
I've searched high and low ( SO question and Google search), but can't seem to find a simple, working command to copy a balanced expression. Has someone already done this?
Thanks
Tim
Function sexp-at-point gives you the sexp ("form") at the cursor. Just copy that to the kill-ring, using kill-ring-save. E.g.:
(defun copy-sexp-at-point ()
(interactive)
(let ((bnds (bounds-of-thing-at-point 'sexp)))
(kill-ring-save (car bnds) (cdr bnds))))
Alternatively, just use kill-new:
(defun copy-sexp-at-point ()
(interactive)
(kill-new (thing-at-point 'sexp)))
The reason your copy-form cannot be bound to a key is that it is a function, not a command - it is missing an interactive form.
However, in your case you don't even need to write a new function.
Try a combination of
mark-sexp is an interactive compiled Lisp function in `lisp.el'.
It is bound to C-M-#, C-M-SPC.
and
M-w runs the command kill-ring-save, which is an interactive compiled
Lisp function in `simple.el'.
It is bound to <C-insertchar>, M-w, <menu-bar> <edit> <copy>.
I'm not sure I understand the question, but when I need to do what I consider as "copy a balanced form", I do: M-C-SPC M-w. If I want to cut it instead, I do M-C-SPC C-w.
Here's what I generally use. Somehow it's more useful for me
to kill the balanced expression instead of copying. If I want a
copy instead, I first kill, then undo.
This function kills a string, if the point is inside string,
otherwise the balanced expression, i.e. (),[],{},<>
or whatever is defined by the syntax.
(defun kill-at-point ()
"Kill the quoted string or the list that includes the point"
(interactive)
(let ((p (nth 8 (syntax-ppss))))
(cond
;; string
((eq (char-after p) ?\")
(goto-char p)
(kill-sexp))
;; list
((ignore-errors (when (eq (char-after) ?\()
(forward-char))
(up-list)
t)
(let ((beg (point)))
(backward-list)
(kill-region beg (point)))))))
I've also tried to add a special case for when the point is
inside the comment, but I couldn't find a generic
way to determine bounds of comment at point. If anyone knows,
please tell me.
This other function can be relevant as well. It marks instead
of killing, like the previous one. The nice thing that it
extends the region each time it's called.
I bind the first one to C-, and the second to
C-M-,.
(defun mark-at-point ()
"Mark the quoted string or the list that includes the point"
(interactive)
(let ((p (nth 8 (syntax-ppss))))
(if (eq (char-after p) ?\")
(progn
(goto-char p)
(set-mark (point))
(forward-sexp))
(progn
(when (eq (char-after) 40)
(forward-char))
(condition-case nil
(progn
(up-list)
(set-mark (point))
(let ((beg (point)))
(backward-list)
(exchange-point-and-mark)))
(error
(when (looking-back "}")
(exchange-point-and-mark)
;; assumes functions are separated by one empty line
(re-search-backward "^[^A-Z-a-z]" nil t)
(forward-char))))))))

Jump to the first occurrence of symbol in Emacs

I use the excellent highlight-symbol.el to move between different occurrences of the same symbol.
In this screenshot, foo_bar is highlighted, and I can call highlight-symbol-prev to jump to it. Note that this is syntax-aware, so it's smart enough to know that foo_bar_baz is different (something isearch doesn't understand).
I'd really like to be able to jump to the first occurrence of a symbol. This would be brilliant for finding where symbols were imported. How would I go about this?
Something along these lines should do what you want.
(defun goto-first-reference ()
(interactive)
(eval
`(progn
(goto-char (point-min))
(search-forward-regexp
(rx symbol-start ,(thing-at-point 'symbol) symbol-end))
(beginning-of-thing 'symbol))))
(eval-when-compile (require 'cl))
(require 'highlight-symbol)
(defmacro save-mark-ring (&rest body)
"Save mark-ring; execute BODY; restore the old mark-ring."
`(let ((old-mark-ring mark-ring))
,#body
(setq mark-ring old-mark-ring)))
(defun highlight-symbol-jump-to-first ()
"Jump to the first occurrence of the symbol at point."
(interactive)
(push-mark)
(save-mark-ring
(let (earliest-symbol-pos)
(loop do
(highlight-symbol-jump -1)
(setq earliest-symbol-pos (point))
while (< (point) earliest-symbol-pos)))))

Scripting magit timing problems

C-x v = vc-diff is good. However, I can work with the diff
directly if the diff was shown in a magit-status buffer.
I've tried to do just that here:
(defvar le::vc-diff-data nil)
(defun le::magit-go-to-change-once ()
(destructuring-bind (filename orig-buff relative-name) le::vc-diff-data
(pop-to-buffer "*magit: magit*")
(goto-char (point-min))
(if (and (search-forward-regexp "^Changes:$" nil t)
;; WIP fix
(progn (magit-show-level-2) t)
(search-forward relative-name nil t))
(progn (recenter-top-bottom 0)
;; WIP fix me here
(magit-show-level-4)
)
;; no diff
(pop-to-buffer orig-buf)
(message "no diff found.")))
(remove-hook 'magit-refresh-status-hook #'le::magit-go-to-change-once))
(defadvice vc-diff (around magit-redirect activate compile)
"redirect to magit"
(let* ((vc-info (vc-deduce-fileset t))
(filename (buffer-file-name))
(orig-buf (current-buffer))
(relative-name (replace-regexp-in-string
(concat "\\`"
(regexp-quote (expand-file-name (locate-dominating-file filename ".git"))))
"" filename)))
(if (string-equal "Git" (car vc-info))
(progn
(setq le::vc-diff-data (list filename orig-buf relative-name))
(add-hook 'magit-refresh-status-hook #'le::magit-go-to-change-once)
(call-interactively 'magit-status))
ad-do-it)))
However the "magit-show-level*" function fails. It works when I use
eval-expression in the magit buffer though. So maybe this is a timing issue
and I have to hook in somewhere else.
As said in my comment, the hook is called at a time when section related function will not work. You could try magit from there: https://github.com/vanicat/magit/tree/t/refresh-stasus-hook, your code should work with it.
Bye the way your proposition is interesting, and integrate it into magit contrib's proposition could be great.

emacs delete-trailing-whitespace except current line

I recently added Emacs (delete-trailing-whitespace) function to my 'before-save-hook for some programming modes, but I find it rather frustrating that it deletes whitespace from the line I am currently editing. Any suggestions as to how to fix this problem?
Since delete-trailing-whitespace respects narrowing, one solution is to narrow the buffer to the portion before the current line and call it, then narrow to the portion after the current line and call it again:
(defun delete-trailing-whitespace-except-current-line ()
(interactive)
(let ((begin (line-beginning-position))
(end (line-end-position)))
(save-excursion
(when (< (point-min) begin)
(save-restriction
(narrow-to-region (point-min) (1- begin))
(delete-trailing-whitespace)))
(when (> (point-max) end)
(save-restriction
(narrow-to-region (1+ end) (point-max))
(delete-trailing-whitespace))))))
Put this function on your before-save-hook instead of delete-trailing-whitespace.
This wrapper for delete-trailing-whitespace can be used to do what you want:
(defun delete-trailing-whitespace-except-current-line ()
"do delete-trailing-whitespace, except preserve whitespace of current line"
(interactive)
(let ((current-line (buffer-substring (line-beginning-position) (line-end-position)))
(backward (- (line-end-position) (point))))
(delete-trailing-whitespace)
(when (not (string-equal (buffer-substring (line-beginning-position) (line-end-position))
current-line))
(delete-region (line-beginning-position) (line-end-position))
(insert current-line)
(backward-char backward))))
I ran into the same problem, and found out that ws-butler perfectly solves it.
There is a simple sample config code:
;; autoload ws-butler on file open
(add-hook 'find-file-hook #'ws-butler-global-mode)
(setq require-final-newline t)
I simply have a wrapper to make two calls to `delete-trailing-whitespace':
(defun modi/delete-trailing-whitespace-buffer ()
"Delete trailing whitespace in the whole buffer, except on the current line.
The current line exception is because we do want to remove any whitespace
on the current line on saving the file (`before-save-hook') while we are
in-between typing something.
Do not do anything if `do-not-delete-trailing-whitespace' is non-nil."
(interactive)
(when (not (bound-and-true-p do-not-delete-trailing-whitespace))
(delete-trailing-whitespace (point-min) (line-beginning-position))
(delete-trailing-whitespace (line-end-position) (point-max))))
(add-hook 'before-save-hook #'modi/delete-trailing-whitespace-buffer)