]> code.delx.au - gnu-emacs-elpa/blob - packages/other-frame-window/other-frame-window.el
Merge commit '078f88ecb797b6cf2cd597417402274dd82402ce' from diff-hl
[gnu-emacs-elpa] / packages / other-frame-window / other-frame-window.el
1 ;;; other-frame-window.el --- Minor mode to enable global prefix keys for other frame/window buffer placement -*- lexical-binding: t -*-
2 ;;
3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
4 ;;
5 ;; Author: Stephen Leake <stephen_leake@member.fsf.org>
6 ;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
7 ;; Keywords: frame window
8 ;; Version: 1.0.1
9 ;; Package-Requires: ((emacs "24.4"))
10 ;;
11 ;; This file is part of GNU Emacs.
12 ;;
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
17 ;;
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
22 ;;
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
25 ;;
26 ;;; Commentary:
27
28 ;;;; Usage:
29 ;;
30 ;; Enable the minor mode with:
31 ;;
32 ;; M-x other-frame-window-mode
33 ;;
34 ;; or, in your ~/.emacs:
35 ;;
36 ;; (other-frame-window-mode t)
37 ;;
38 ;; C-x 7 <command> causes a buffer displayed by <command> to appear in
39 ;; another window in the same frame; a window is created if necessary.
40 ;;
41 ;; C-x 9 <command> causes a buffer displayed by <command> to appear in
42 ;; another frame; a frame is created if necessary.
43
44 ;;;; Design:
45 ;;
46 ;; This uses C-x 7, 9 prefix because those keys are undefined in core
47 ;; Emacs. It could eventually switch to 4, 5, since those are
48 ;; currently used for -other-window, -other-frame bindings.
49 ;;
50 ;; (info "(emacs) Pop Up Window") (info "(emacs) Creating Frames")
51 ;;
52 ;; This adds advice to switch-to-buffer; eventually Emacs could
53 ;; reimplement switch-to-buffer to do the same.
54
55 ;;;; Todo:
56
57 ;; - Pay attention to bindings added to ctl-x-4-map and ctl-x-5-map
58 ;; - Should `C-x 7 C-h' display the transient map?
59 ;; - `C-x 7 C-h k f' should show `find-file' rather than `self-insert-command'.
60 ;; This should probably be fixed in set-transient-map.
61
62 ;;; Code:
63
64 (defvar ofw--just-set nil
65 "Non-nil if we just set the prefix in the previous command.")
66
67 (defvar ofw-transient-map
68 (let ((map (make-sparse-keymap)))
69 ;; This is basically the union of the default C-x 4 and C-x 5
70 ;; keymaps in Emacs-25.
71 (define-key map [?\C-f] #'find-file)
72 (define-key map [?\C-o] #'display-buffer)
73 (define-key map [?.]
74 (if (fboundp 'xref-find-definitions) ;Emacs≥25.
75 'xref-find-definitions 'find-tag))
76 (define-key map [?0] #'ofw-dwim-delete-this)
77 (define-key map [?1] #'ofw-dwim-one)
78 (define-key map [?2] #'ofw-dwim-open-other)
79 (define-key map [?a] #'add-change-log-entry)
80 (define-key map [?b] #'switch-to-buffer)
81 (define-key map [?c] #'clone-indirect-buffer)
82 (define-key map [?d] #'dired)
83 (define-key map [?f] #'find-file)
84 (define-key map [?m] #'compose-mail)
85 (define-key map [?o] #'ofw-dwim-select-other)
86 (define-key map [?r] #'find-file-read-only)
87 map)
88 "Keymap used for one command right after setting the prefix.")
89
90 (defun ofw--set-prefix (func)
91 "Add ofw prefix function FUNC."
92 (ofw-delete-from-overriding)
93 (let ((functions (car display-buffer-overriding-action))
94 (attrs (cdr display-buffer-overriding-action)))
95 (push func functions)
96 (setq display-buffer-overriding-action (cons functions attrs))
97 ;; C-u C-x 7 foo should pass C-u to foo, not to C-x 7, so
98 ;; pass the normal prefix to the next command.
99 (if (fboundp 'prefix-command-preserve-state)
100 (prefix-command-preserve-state)
101 ;; Make sure the next pre-command-hook doesn't immediately set
102 ;; display-buffer-overriding-action back to nil.
103 (setq ofw--just-set t)
104 (setq prefix-arg current-prefix-arg))
105 (set-transient-map ofw-transient-map)))
106
107 (defun ofw--echo-keystrokes ()
108 (let ((funs (car display-buffer-overriding-action)))
109 (cond
110 ((memq #'ofw-display-buffer-other-frame funs) "[other-frame]")
111 ((memq #'ofw-display-buffer-other-window funs) "[other-window]"))))
112
113 (when (boundp 'prefix-command-echo-keystrokes-functions)
114 (add-hook 'prefix-command-echo-keystrokes-functions
115 #'ofw--echo-keystrokes))
116
117 (defun ofw--preserve-state () (setq ofw--just-set t))
118 (when (boundp 'prefix-command-preserve-state-hook)
119 (add-hook 'prefix-command-preserve-state-hook
120 #'ofw--preserve-state))
121
122 (defun ofw-delete-from-overriding ()
123 "Remove ourselves from 'display-buffer-overriding-action' action list, if present."
124 (let ((functions (car display-buffer-overriding-action))
125 (attrs (cdr display-buffer-overriding-action)))
126 (setq functions (delq #'ofw-display-buffer-other-frame
127 (delq #'ofw-display-buffer-other-window functions)))
128 (setq display-buffer-overriding-action
129 (when (or functions attrs) (cons functions attrs)))))
130
131 (defun ofw-other-window ()
132 "Set `display-buffer-overriding-action' to indicate other window."
133 (interactive)
134 (ofw--set-prefix #'ofw-display-buffer-other-window))
135
136 (defun ofw-other-frame ()
137 "Set `display-buffer-overriding-action' to indicate other frame."
138 (interactive)
139 (ofw--set-prefix #'ofw-display-buffer-other-frame))
140
141 (defun ofw-display-buffer-other-window (buffer alist)
142 "Show BUFFER in another window in the current frame,
143 creating new window if needed and allowed.
144 If successful, return window; else return nil.
145 Intended for 'display-buffer-overriding-action'."
146 ;; Reset for next display-buffer call. Normally, this is taken care
147 ;; of by ofw--reset-prefix, but we do it here in case the user does
148 ;; two ofw prefixed commands consecutively.
149 (ofw-delete-from-overriding)
150
151 ;; We can't use display-buffer-use-some-window here, because
152 ;; that unconditionally allows another frame.
153 (or (display-buffer-use-some-frame
154 buffer
155 (append (list (cons 'frame-predicate
156 (lambda (frame) (eq frame (selected-frame))))
157 '(inhibit-same-window . t))
158 alist))
159 (display-buffer-pop-up-window buffer alist)))
160
161 (defun ofw-display-buffer-other-frame (buffer alist)
162 "Show BUFFER in another frame, creating a new frame if needed.
163 If successful, return window; else return nil.
164 Intended for 'display-buffer-overriding-action'."
165 ;; Reset for next display-buffer call.
166 (ofw-delete-from-overriding)
167
168 (or (display-buffer-use-some-frame buffer alist)
169 (display-buffer-pop-up-frame buffer alist)))
170
171 ;; FIXME: use defadvice for Emacs 24.3
172 (defun ofw-switch-to-buffer-advice (orig-fun buffer
173 &optional norecord force-same-window)
174 "Change `switch-to-buffer' to call `pop-to-buffer'.
175 This allows `switch-to-buffer' to respect `ofw-other-window',
176 `ofw-other-frame'."
177 (if display-buffer-overriding-action
178 (pop-to-buffer buffer (list #'display-buffer-same-window) norecord)
179 (funcall orig-fun buffer norecord force-same-window)))
180
181 ;; FIXME: use defadvice for Emacs 24.3
182 (defun ofw--suspend-and-restore (orig-func &rest args)
183 "Call ORIG-FUNC without any ofw actions on 'display-buffer-overriding-action'."
184 (let ((display-buffer-overriding-action display-buffer-overriding-action))
185 ;; FIXME: ofw-delete-from-overriding operates destructively, so the
186 ;; subsequent "restore" step only works if our ofw actions were all at the
187 ;; very beginning display-buffer-overriding-action (in which case `delq'
188 ;; happens not to be destructive).
189 (ofw-delete-from-overriding)
190 (apply orig-func args)))
191
192 (defun ofw-move-to-other-window ()
193 "Move current buffer to another window in same frame.
194 Point stays in moved buffer."
195 (interactive)
196 (let ((buffer (current-buffer)))
197 (switch-to-prev-buffer nil 'bury)
198 (pop-to-buffer
199 buffer
200 (cons '(display-buffer-use-some-frame display-buffer-pop-up-window)
201 (list (cons 'frame-predicate (lambda (frame) (eq frame (selected-frame))))
202 '(inhibit-same-window . t)))
203 )))
204
205 (defun ofw-move-to-other-frame ()
206 "Move current buffer to a window in another frame.
207 Point stays in moved buffer."
208 (interactive)
209 (let ((buffer (current-buffer)))
210 (switch-to-prev-buffer nil 'bury)
211 (pop-to-buffer
212 buffer
213 (cons '(display-buffer-use-some-frame display-buffer-pop-up-frame)
214 '((reusable-frames . visible)))
215 )))
216
217 (defvar other-frame-window-mode-map
218 (let ((map (make-sparse-keymap)))
219 (define-key map "\C-x7" #'ofw-other-window)
220 (define-key map "\C-x9" #'ofw-other-frame)
221 (define-key map "\C-xW" #'ofw-move-to-other-window)
222 (define-key map "\C-xF" #'ofw-move-to-other-frame)
223 map)
224 "Local keymap used for other-frame-window minor mode.")
225
226 (defun ofw--reset-prefix ()
227 (if ofw--just-set
228 (setq ofw--just-set nil)
229 (ofw-delete-from-overriding)))
230
231 ;;;###autoload
232 (define-minor-mode other-frame-window-mode
233 "Minor mode for other frame/window buffer placement.
234 Enable mode if ARG is positive."
235 :global t
236
237 (remove-hook 'pre-command-hook #'ofw--reset-prefix)
238
239 (if other-frame-window-mode
240 ;; enable
241 (progn
242 (add-hook 'pre-command-hook #'ofw--reset-prefix)
243
244 ;; We assume Emacs code calls pop-to-buffer when there is a good
245 ;; reason to put the buffer in another window, so we don't mess
246 ;; with the default actions, except to allow
247 ;; display-buffer-reuse-window to use a window in another frame;
248 ;; add (reusable-frames . visible) to display-buffer-base-action
249 ;; attributes alist.
250 (let ((functions (car display-buffer-base-action))
251 (attrs (cdr display-buffer-base-action)))
252 (push '(reusable-frames . visible) attrs)
253 (setq display-buffer-base-action (cons functions attrs)))
254
255 ;; Change switch-to-buffer to use display-buffer
256 (if (fboundp 'advice-add) ;Emacs≥24.4
257 (advice-add 'switch-to-buffer :around #'ofw-switch-to-buffer-advice)
258 ;; FIXME: `ad-activate' affects all pieces of advice of that
259 ;; function, which is not what we want!
260 ;; (ad-activate 'switch-to-buffer)
261 )
262
263 ;; Completing-read <tab> pops up a buffer listing completions;
264 ;; that should not respect or consume
265 ;; ofw-frame-window-prefix-arg.
266 (if (fboundp 'advice-add)
267 (advice-add 'read-from-minibuffer
268 :around #'ofw--suspend-and-restore)
269 ;; FIXME: `ad-activate' affects all pieces of advice of that
270 ;; function, which is not what we want!
271 ;; (ad-activate 'read-from-minibuffer)
272 )
273 )
274
275 ;; else disable
276 (let ((functions (car display-buffer-base-action))
277 (attrs (cdr display-buffer-base-action)))
278 (setq attrs (delq '(reusable-frames . visible) attrs))
279 (setq display-buffer-base-action (cons functions attrs)))
280
281 (advice-remove 'switch-to-buffer #'ofw-switch-to-buffer-advice)
282 (advice-remove 'read-from-minibuffer #'ofw--suspend-and-restore)
283 ))
284
285 (unless (fboundp 'display-buffer-use-some-frame)
286 ;; in Emacs 25; define here for earlier
287
288 (defun display-buffer-use-some-frame (buffer alist)
289 "Display BUFFER in an existing frame that meets a predicate
290 \(by default any frame other than the current frame). If
291 successful, return the window used; otherwise return nil.
292
293 If ALIST has a non-nil `inhibit-switch-frame' entry, avoid
294 raising the frame.
295
296 If ALIST has a non-nil `frame-predicate' entry, its value is a
297 function taking one argument (a frame), returning non-nil if the
298 frame is a candidate; this function replaces the default
299 predicate.
300
301 If ALIST has a non-nil `inhibit-same-window' entry, avoid using
302 the currently selected window (only useful with a frame-predicate
303 that allows the selected frame)."
304 (let* ((predicate (or (cdr (assq 'frame-predicate alist))
305 (lambda (frame)
306 (and
307 (not (eq frame (selected-frame)))
308 (not (window-dedicated-p
309 (or
310 (get-lru-window frame)
311 (frame-first-window frame)))))
312 )))
313 (frame (car (filtered-frame-list predicate)))
314 (window (and frame (get-lru-window frame nil (cdr (assq 'inhibit-same-window alist))))))
315 (when window
316 (prog1
317 (window--display-buffer
318 buffer window 'frame alist display-buffer-mark-dedicated)
319 (unless (cdr (assq 'inhibit-switch-frame alist))
320 (window--maybe-raise-frame frame))))
321 ))
322 )
323
324 ;; Some of the commands on the transient keymap don't actually *display*
325 ;; in another window/frame but instead do something either at the level
326 ;; of windows or frames. I call those "ofw-dwim-*".
327
328 (defun ofw-dwim--frame-p ()
329 "Return non-nil if the prefix is for \"other-frame\" rather than window."
330 ;; FIXME: Comparing functions is ugly/hackish!
331 (memq #'ofw-display-buffer-other-frame
332 (car display-buffer-overriding-action)))
333
334 (defun ofw-dwim-delete-this ()
335 "Delete this frame or window."
336 (interactive)
337 (call-interactively
338 (if (ofw-dwim--frame-p) #'delete-frame #'kill-buffer-and-window)))
339
340 (defun ofw-dwim-one ()
341 "Delete all other frames or windows."
342 (interactive)
343 (call-interactively
344 (if (ofw-dwim--frame-p) #'delete-other-frames #'delete-other-windows)))
345
346 (defun ofw-dwim-open-other ()
347 "Show current buffer in other frame or window."
348 (interactive)
349 (if (ofw-dwim--frame-p)
350 ;; FIXME: This is the old C-x 5 2 behavior, but maybe it should just use
351 ;; display-buffer instead!
352 (call-interactively #'make-frame-command)
353 (display-buffer (current-buffer))))
354
355 (defun ofw-dwim-select-other ()
356 "Select other frame or window."
357 (interactive)
358 (call-interactively (if (ofw-dwim--frame-p) #'other-frame #'other-window)))
359
360 (provide 'other-frame-window)
361 ;;; other-frame-window.el ends here