Emacs ediff marked files in different dired buffers - emacs

I have the following function which runs ediff on the files I have marked in a dired buffer:
(defun mkm/ediff-marked-pair ()
"Run ediff-files on a pair of files marked in dired buffer"
(interactive)
(let ((marked-files (dired-get-marked-files nil)))
(if (not (= (length marked-files) 2))
(message "mark exactly 2 files")
(ediff-files (nth 0 marked-files)
(nth 1 marked-files)))))
It only works on files in the same directory, how could I make it work for files I mark in different dired directories?

Here is my solution, it works for files marked in the same dired buffer and also for files in different buffers.
(defun mkm/ediff-marked-pair ()
"Run ediff-files on a pair of files marked in dired buffer"
(interactive)
(let* ((marked-files (dired-get-marked-files nil nil))
(other-win (get-window-with-predicate
(lambda (window)
(with-current-buffer (window-buffer window)
(and (not (eq window (selected-window)))
(eq major-mode 'dired-mode))))))
(other-marked-files (and other-win
(with-current-buffer (window-buffer other-win)
(dired-get-marked-files nil)))))
(cond ((= (length marked-files) 2)
(ediff-files (nth 0 marked-files)
(nth 1 marked-files)))
((and (= (length marked-files) 1)
(= (length other-marked-files) 1))
(ediff-files (nth 0 marked-files)
(nth 0 other-marked-files)))
(t (error "mark exactly 2 files, at least 1 locally")))))

Augmenting mkm's answer a bit. In addition to working on 2 marked files potentially across dired buffers, it handles the case when there are 0 or 1 marked files. 0 marked files will use the file under the cursor as file A, and prompt for a file to compare with. 1 marked files will use the marked file as file A, and prompt for a file to compare with. The file under the point is used as the default in the prompt. I bound this to =.
(defun mkm/ediff-marked-pair ()
"Run ediff-files on a pair of files marked in dired buffer"
(interactive)
(let* ((marked-files (dired-get-marked-files nil nil))
(other-win (get-window-with-predicate
(lambda (window)
(with-current-buffer (window-buffer window)
(and (not (eq window (selected-window)))
(eq major-mode 'dired-mode))))))
(other-marked-files (and other-win
(with-current-buffer (window-buffer other-win)
(dired-get-marked-files nil)))))
(cond ((= (length marked-files) 2)
(ediff-files (nth 0 marked-files)
(nth 1 marked-files)))
((and (= (length marked-files) 1)
(= (length other-marked-files) 1))
(ediff-files (nth 0 marked-files)
(nth 0 other-marked-files)))
((= (length marked-files) 1)
(let ((single-file (nth 0 marked-files)))
(ediff-files single-file
(read-file-name
(format "Diff %s with: " single-file)
nil (m (if (string= single-file (dired-get-filename))
nil
(dired-get-filename))) t))))
(t (error "mark no more than 2 files")))))

Here's a solution:
(defvar mkm/dired-file-1)
(defun mkm/ediff-push ()
(interactive)
(setq mkm/dired-file-1 (dired-get-filename)))
(defun mkm/ediff-pop ()
(interactive)
(ediff-files mkm/dired-file-1 (dired-get-filename)))
(add-hook 'dired-mode-hook
(lambda()
(define-key dired-mode-map (kbd "C-c u") 'mkm/ediff-push)
(define-key dired-mode-map (kbd "C-c o") 'mkm/ediff-pop)))

Related

Best way to add per-line information visually in emacs?

I'm writing a minor mode for emacs which, at the very least, will calculate a numeric value for each line in a buffer. I want to display this visually, preferable neatly before each line.
I know some minor modes draw to the fringe, and I know overlays are an option too (are these related?), but I can't find a good example of what I want anywhere.
Basically, I want to have something like the line numbers from linum-mode, but they will need to change every time the buffer is modified (actually, only whenever the line they're on changes). Something like a character counter for each line would be a good example. And I'd like it to not break linum-mode, but not depend on it, etc, if possible.
Here is a quick example of one way to put an overlay after linum-mode numbers and before the line of text. I will need to give some thought about right-alignment of the character count.
NOTE:  This method contemplates that the linum-mode numbers are generated before the code that follows in this example. If the post-command-hook or the widow-scroll-functions hook is used to implement this proposed method, then those additions to the hooks would need to follow in time subsequently to the linum-mode functions attached to those same hooks.
The following example could be implemented with the post-command-hook and the window-scroll-functions hook. See the following link for an example of how to determine window-start and window-end before a redisplay occurs: https://stackoverflow.com/a/24216247/2112489
EDIT:  Added right-alignment of character count -- contemplates a maximum of three digits (i.e., up to 999 characters per line). The text after the character count overlays are now left-aligned.
(save-excursion
(let* (
(window-start (window-start))
(window-end (window-end)))
(goto-char window-end)
(while (re-search-backward "\n" window-start t)
(let* (
(pbol (point-at-bol))
(peol (point-at-eol))
(raw-char-count (abs (- peol pbol)))
(starting-column
(propertize (char-to-string ?\uE001)
'display
`((space :align-to 1)
(space :width 0))))
(colored-char-count
(propertize (number-to-string raw-char-count)
'face '(:background "gray50" :foreground "black")
'cursor t))
(one-spacer
(propertize (char-to-string ?\uE001)
'display
`((space :width 1))))
(two-spacers
(propertize (char-to-string ?\uE001)
'display
`((space :width 2))))
(final-char-count
(cond
((and
(< raw-char-count 100)
(> raw-char-count 9))
(concat one-spacer colored-char-count))
((< raw-char-count 10)
(concat two-spacers colored-char-count))
(t colored-char-count))) )
(overlay-put (make-overlay pbol pbol)
'before-string
(concat starting-column final-char-count two-spacers) )))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; M-x char-count-mode
(defvar char-count-p nil
"When `char-count-p` is non-`nil`, the overlays are present.")
(make-variable-buffer-local 'char-count-p)
(defvar char-count-this-command nil
"This local variable is set within the `post-command-hook`; and,
is also used by the `window-scroll-functions` hook.")
(make-variable-buffer-local 'char-count-this-command)
(defvar char-count-overlay-list nil
"List used to store overlays until they are removed.")
(make-variable-buffer-local 'char-count-overlay-list)
(defun char-count-post-command-hook ()
"Doc-string."
(setq char-count-this-command this-command)
(character-count-function))
(defun character-count-window-scroll-functions (win _start)
"Doc-string."
(character-count-function))
(defun equal-including-properties--remove-overlays (beg end name val)
"Remove the overlays using `equal`, instead of `eq`."
(when (and beg end name val)
(overlay-recenter end)
(dolist (o (overlays-in beg end))
(when (equal-including-properties (overlay-get o name) val)
(delete-overlay o)))))
(defun character-count-function ()
"Doc-string for the character-count-function."
(when
(and
char-count-mode
char-count-this-command
(window-live-p (get-buffer-window (current-buffer)))
(not (minibufferp))
(pos-visible-in-window-p (point)
(get-buffer-window (current-buffer) (selected-frame)) t) )
(remove-char-count-overlays)
(save-excursion
(let* (
counter
(selected-window (selected-window))
(window-start (window-start selected-window))
(window-end (window-end selected-window t)) )
(goto-char window-end)
(catch 'done
(while t
(when counter
(re-search-backward "\n" window-start t))
(when (not counter)
(setq counter t))
(let* (
(pbol (point-at-bol))
(peol (point-at-eol))
(raw-char-count (abs (- peol pbol)))
(starting-column
(propertize (char-to-string ?\uE001)
'display
`((space :align-to 1) (space :width 0))))
(colored-char-count
(propertize (number-to-string raw-char-count)
'face '(:background "gray50" :foreground "black")))
(one-spacer
(propertize (char-to-string ?\uE001)
'display
`((space :width 1))))
(two-spacers
(propertize (char-to-string ?\uE001)
'display
`((space :width 2))))
(final-char-count
(cond
((and
(< raw-char-count 100)
(> raw-char-count 9))
(concat one-spacer colored-char-count))
((< raw-char-count 10)
(concat two-spacers colored-char-count))
(t colored-char-count)))
(ov-string (concat starting-column final-char-count two-spacers)) )
(push ov-string char-count-overlay-list)
(overlay-put (make-overlay pbol pbol) 'before-string ov-string)
(when (<= pbol window-start)
(throw 'done nil)) )))
(setq char-count-p t)))
(setq char-count-this-command nil) ))
(defun remove-char-count-overlays ()
(when char-count-p
(require 'cl)
(setq char-count-overlay-list
(remove-duplicates char-count-overlay-list
:test (lambda (x y) (or (null y) (equal-including-properties x y)))
:from-end t))
(dolist (description char-count-overlay-list)
(equal-including-properties--remove-overlays (point-min) (point-max) 'before-string description))
(setq char-count-p nil) ))
(defun turn-off-char-count-mode ()
(char-count-mode -1))
(define-minor-mode char-count-mode
"A minor-mode that places the character count at the beginning of the line."
:init-value nil
:lighter " Char-Count"
:keymap nil
:global nil
:group nil
(cond
(char-count-mode
(setq scroll-conservatively 101)
(add-hook 'post-command-hook 'char-count-post-command-hook t t)
(add-hook 'window-scroll-functions
'character-count-window-scroll-functions t t)
(add-hook 'change-major-mode-hook 'turn-off-char-count-mode nil t)
(message "Turned ON `char-count-mode`."))
(t
(remove-char-count-overlays)
(remove-hook 'post-command-hook 'char-count-post-command-hook t)
(remove-hook 'window-scroll-functions
'character-count-window-scroll-functions t)
(remove-hook 'change-major-mode-hook 'turn-off-char-count-mode t)
(kill-local-variable 'scroll-conservatively)
(message "Turned OFF `char-count-mode`.") )))
(provide 'char-count)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

How to view man page using Info in Emacs?

I can view man pages using info in the terminal:
info pthread_create
However, it is not possible with info in Emacs, even with info-apropos or info-menu.
EDIT:
It seems that fall-backs are not in the concept of Info-mode.
There follows a work-around applying advice. It does not work perfect but around the missing feature ;-).
It defines a fall-back for Info-goto-node (in Info-mode bound to g) and for Info-menu (in Info-mode bound to m).
Furthermore, it adds manual-apropos to info-apropos.
(require 'woman)
(defun Info-man-completion (_caller _info string predicate action)
"Add man entries to info completion."
;; prepare woman:
(unless (and woman-expanded-directory-path woman-topic-all-completions)
(setq woman-expanded-directory-path
(woman-expand-directory-path woman-manpath woman-path)
woman-topic-all-completions
(woman-topic-all-completions woman-expanded-directory-path)))
;; do completions:
(cond
((null action) ;; try-completion
;; shortest wins
(let ((_man (try-completion string woman-topic-all-completions)))
(cond
((eq _info t)
t)
((eq _man t)
t)
((and (stringp _info) (stringp _man))
(if (> (length _info) (length _man))
_man
_info))
((stringp _info)
_info)
(t _man)
)))
((eq action t) ;; all-completions
(let ((_man (all-completions string woman-topic-all-completions)))
(append _info _man)
))
((eq action 'lambda) ;; test-completion
(try-completion string _caller))
((eq action 'metadata) ;; state of current completion
'(metadata) ;; no specification
)))
;; args: string predicate code
(defadvice Info-read-node-name-1 (around man activate)
"Add man entries to info completion."
(setq ad-return-value (apply 'Info-man-completion 'Info-read-node-name-1 ad-do-it (ad-get-args 0))))
;;
(defadvice Info-complete-menu-item (around man activate)
"Add man entries to info completion."
(setq ad-return-value (apply 'Info-man-completion 'Info-complete-menu-item ad-do-it (ad-get-args 0))))
(defadvice Info-goto-node (around man activate)
"If no info node is found for string lookup and show man entry."
(condition-case err
ad-do-it
(user-error
(let ((err-str (car-safe (cdr err))))
(if (and (stringp err-str)
(string-match "No such node or anchor:" err-str))
(man (ad-get-arg 0))
(signal 'user-error err-str)
)))))
(defadvice Info-menu (around man activate)
"If no info menu entry is found for string lookup and show man entry."
(condition-case err
ad-do-it
(user-error
(let ((err-str (car-safe (cdr err))))
(if (and (stringp err-str)
(string-match "No such item in menu" err-str))
(man (ad-get-arg 0))
(signal 'user-error err-str)
)))))
(defadvice Info-apropos-find-node (after man activate)
"Add man appropos to info appropos."
(let (item)
(goto-char (point-max))
(let ((inhibit-read-only t))
(insert "\nMatches found by man-apropos\n\n")
(let ((beg (point))
(nodeinfo (assoc nodename Info-apropos-nodes)))
(if nodeinfo
(let ((search-string (nth 1 nodeinfo)))
(call-process "apropos" nil t t search-string)
(goto-char beg)
(while (re-search-forward "^\\(\\(?:[[:alnum:]]\\|\\s_\\)+\\)\\(?:[[:blank:]]+\\[\\]\\)?\\([[:blank:]]+([[:alnum:]]+)\\)[[:blank:]]+-[[:blank:]]+\\(.*\\)$" nil t)
(replace-match (replace-regexp-in-string "\\\\" "\\\\\\\\" (format "* %-38s.%s"
(format "%s:" (match-string 1))
(concat (match-string 1) (match-string 2))
(match-string 3))))))
(man nodename)
)))))
Info gives an error that the node is not available. Thereafter, the manual page is shown if there is one.
[Edited]
EmacsWiki says that iman:
Opens either an info format manual with InfoMode or a man page with
ManMode.
It links to the author's website:
http://homepage1.nifty.com/bmonkey/emacs/elisp/iman.el
Found M-x woman MANPAGE RET to most convenient way to call manpages from inside Emacs.

Toggle case of next letter in elisp

I'd like to be able to toggle the case of the letter under the point. To that end, I wrote this:
(defun toggle-case-next-letter ()
"Toggles the case of the next letter, then moves the point forward one character"
(interactive)
(let* ((p (point))
(upcased (upcasep (char-after)))
(f (if upcased 'downcase-region 'upcase-region)))
(progn
(f p (+ 1 p))
(forward-char))))
However, when I run it (I've bound it to M-#), I get progn: Symbol's function definition is void: f. I assume this means f isn't bound, but I'm not sure.
Upcasep is defined as:
(defun upcasep (c) (eq c (upcase c)))
Is the problem in the let binding, or something else? (Also, if there's a better way to do this, that'd be nice as well).
Note that originally I had (upcased (upcasep (buffer-substring-no-properties p (+ 1 p)))), which I've corrected to (upcased (upcasep (char-after)), because using upcasep as defined above is always nil for strings (so I couldn't downcase again).
You've got a typical case of lisp-1 / lisp-2 confusion. Here's a fix (just a funcall):
(defun toggle-case-next-letter ()
"Toggles the case of the next letter, then moves the point forward one character"
(interactive)
(let* ((p (point))
(upcased (char-upcasep (buffer-substring-no-properties p (+ 1 p))))
(f (if upcased 'downcase-region 'upcase-region)))
(progn
(funcall f p (+ 1 p))
(forward-char))))
And here's what I have:
(global-set-key (kbd "C->") 'upcase-word-toggle)
(global-set-key (kbd "C-z") 'capitalize-word-toggle)
(defun char-upcasep (letter)
(eq letter (upcase letter)))
(defun capitalize-word-toggle ()
(interactive)
(let ((start (car
(save-excursion
(backward-word)
(bounds-of-thing-at-point 'symbol)))))
(if start
(save-excursion
(goto-char start)
(funcall
(if (char-upcasep (char-after))
'downcase-region
'upcase-region)
start (1+ start)))
(capitalize-word -1))))
(defun upcase-word-toggle ()
(interactive)
(let ((bounds (bounds-of-thing-at-point 'symbol))
beg end
regionp)
(if (eq this-command last-command)
(setq regionp (get this-command 'regionp))
(put this-command 'regionp nil))
(cond
((or (region-active-p) regionp)
(setq beg (region-beginning)
end (region-end))
(put this-command 'regionp t))
(bounds
(setq beg (car bounds)
end (cdr bounds)))
(t
(setq beg (point)
end (1+ beg))))
(save-excursion
(goto-char (1- beg))
(and (re-search-forward "[A-Za-z]" end t)
(funcall (if (char-upcasep (char-before))
'downcase-region
'upcase-region)
beg end)))))
I couldn't get #abo-abo's answer working for me but using his comments I was able to google better and found the following at http://chneukirchen.org/dotfiles/.emacs
(defun chris2-toggle-case ()
(interactive)
(let ((char (following-char)))
(if (eq char (upcase char))
(insert-char (downcase char) 1 t)
(insert-char (upcase char) 1 t)))
(delete-char 1 nil)
(backward-char))
(global-set-key (kbd "M-#") 'chris2-toggle-case)
This answers the original question if you remove (backward-char).
I realize this is a very old question, but having stumbled upon the same problem recently, I'd like to suggest a simpler solution.
I start with a pure function for toggling character case, based on char code property inspection:
(cl-defun toggle-char-case (c)
(cl-case (get-char-code-property c 'general-category)
(Lu (downcase c))
(Ll (upcase c))
(t c)))
I then use it from within an interactive function operating at point:
(cl-defun toggle-char-case-at-point ()
(interactive)
(let ((new (toggle-char-case (char-after))))
(delete-char 1)
(insert new)))
I then bound this interactive function to a keybinding of my choice:
(global-set-key (kbd "C-M-c") 'toggle-char-case-at-point)
The way this function operates is, after toggling the case it advances the point by one. So calling it repeatedly will toggle the cases of a sequence of chars. One could make it keep the point unchanged - that would require adding (backward-char) to the body.

Keyboard scrolling with acceleration

One can easily map some key to scroll up.
(defun up1()
(interactive)
(scroll-up 1))
(defun up2()
(interactive)
(scroll-up 2))
(global-set-key "\M-]" 'up2)
I am looking instead for the following behavior. The first handful of
scrolls would call up1() and the subsequent ones would call up2().
How about this:
(setq my-scroll-counter 0)
(setq my-scroll-limit 5)
(defun up1()
(interactive)
(if (eq last-command this-command)
(incf my-scroll-counter)
(setq my-scroll-counter 0))
(if (> my-scroll-counter my-scroll-limit)
(scroll-up 2)
(scroll-up 1)))
(global-set-key "\M-]" 'up1)
If you want something a little fancier, you calculate your scroll step dynamically based on how many times you repeat the command:
(setq my-scroll-counter 0)
(setq my-maximum-scroll 20)
(setq my-scroll-acceleration 4)
(defun up1()
(interactive)
(if (eq last-command this-command)
(incf my-scroll-counter)
(setq my-scroll-counter 0))
(scroll-up (min
(+ 1 (/ my-scroll-counter my-scroll-acceleration))
my-maximum-scroll)))
(global-set-key "\M-]" 'up1)

In emacs, can I set up the *Messages* buffer so that it tails?

Basically I want the *Messages* buffer to always scroll to the bottom when a new message arrives.
Can I do that?
I found auto-revert-tail-mode but that works for buffers that are visiting files.
When I tried it in the Messages buffer, it popped an error:
auto-revert-tail-mode: This buffer is not visiting a file
For multiple frames you probably want:
(defadvice message (after message-tail activate)
"goto point max after a message"
(with-current-buffer "*Messages*"
(goto-char (point-max))
(walk-windows (lambda (window)
(if (string-equal (buffer-name (window-buffer window)) "*Messages*")
(set-window-point window (point-max))))
nil
t)))
Just put point at the end of the buffer M->. If you don't manually move it it will stay there -- IOW, you will always see the tail.
This code seems a bit overkill, but a the simple (goto-char (point-max)) wasn't working for me:
(defadvice message (after message-tail activate)
"goto point max after a message"
(with-current-buffer "*Messages*"
(goto-char (point-max))
(let ((windows (get-buffer-window-list (current-buffer) nil t)))
(while windows
(set-window-point (car windows) (point-max))
(setq windows (cdr windows))))))
Here's an implementation that uses the new advice style.
(defun message-buffer-goto-end-of-buffer (&rest args)
(let* ((win (get-buffer-window "*Messages*"))
(buf (and win (window-buffer win))))
(and win (not (equal (current-buffer) buf))
(set-window-point
win (with-current-buffer buf (point-max))))))
(advice-add 'message :after 'message-buffer-goto-end-of-buffer)
i run 23.3 and there were still way too many occasions where the built-in 'solution' and the orginal defadvice on the message function just didn't cut it, so i wrapped that code in a list / toggle / timer set up and it's working beautifully - no more frustration when debugging!
it's generic, so works on any buffer, although i only really use it for..
(toggle-buffer-tail "*Messages*" "on")
..hope it's useful to someone.
;alist of 'buffer-name / timer' items
(defvar buffer-tail-alist nil)
(defun buffer-tail (name)
"follow buffer tails"
(cond ((or (equal (buffer-name (current-buffer)) name)
(string-match "^ \\*Minibuf.*?\\*$" (buffer-name (current-buffer)))))
((get-buffer name)
(with-current-buffer (get-buffer name)
(goto-char (point-max))
(let ((windows (get-buffer-window-list (current-buffer) nil t)))
(while windows (set-window-point (car windows) (point-max))
(with-selected-window (car windows) (recenter -3)) (setq windows (cdr windows))))))))
(defun toggle-buffer-tail (name &optional force)
"toggle tailing of buffer NAME. when called non-interactively, a FORCE arg of 'on' or 'off' can be used to to ensure a given state for buffer NAME"
(interactive (list (cond ((if name name) (read-from-minibuffer
(concat "buffer name to tail"
(if buffer-tail-alist (concat " (" (caar buffer-tail-alist) ")") "") ": ")
(if buffer-tail-alist (caar buffer-tail-alist)) nil nil
(mapcar '(lambda (x) (car x)) buffer-tail-alist)
(if buffer-tail-alist (caar buffer-tail-alist)))) nil)))
(let ((toggle (cond (force force) ((assoc name buffer-tail-alist) "off") (t "on")) ))
(if (not (or (equal toggle "on") (equal toggle "off")))
(error "invalid 'force' arg. required 'on'/'off'")
(progn
(while (assoc name buffer-tail-alist)
(cancel-timer (cdr (assoc name buffer-tail-alist)))
(setq buffer-tail-alist (remove* name buffer-tail-alist :key 'car :test 'equal)))
(if (equal toggle "on")
(add-to-list 'buffer-tail-alist (cons name (run-at-time t 1 'buffer-tail name))))
(message "toggled 'tail buffer' for '%s' %s" name toggle)))))
edit: changed functionality to display tail at the bottom of the window
Here's an amendment over Peter's / Trey's solutions
(defun modi/messages-auto-tail (&rest _)
"Make *Messages* buffer auto-scroll to the end after each message."
(let* ((buf-name "*Messages*")
;; Create *Messages* buffer if it does not exist
(buf (get-buffer-create buf-name)))
;; Activate this advice only if the point is _not_ in the *Messages* buffer
;; to begin with. This condition is required; otherwise you will not be
;; able to use `isearch' and other stuff within the *Messages* buffer as
;; the point will keep moving to the end of buffer :P
(when (not (string= buf-name (buffer-name)))
;; Go to the end of buffer in all *Messages* buffer windows that are
;; *live* (`get-buffer-window-list' returns a list of only live windows).
(dolist (win (get-buffer-window-list buf-name nil :all-frames))
(with-selected-window win
(goto-char (point-max))))
;; Go to the end of the *Messages* buffer even if it is not in one of
;; the live windows.
(with-current-buffer buf
(goto-char (point-max))))))
(advice-add 'message :after #'modi/messages-auto-tail)