code.delx.au - gnu-emacs-elpa/blob - 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.2
   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 (remq #'ofw-display-buffer-other-frame
 127                           (remq #'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   ;; IMPROVEME: prompt for a frame if more than 2
 169   (or (display-buffer-use-some-frame buffer alist)
 170       (display-buffer-pop-up-frame buffer alist)))
 171
 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 (defun ofw--suspend-and-restore (orig-func &rest args)
 182   "Call ORIG-FUNC without any ofw actions on `display-buffer-overriding-action'."
 183   (let ((display-buffer-overriding-action display-buffer-overriding-action))
 184     (ofw-delete-from-overriding)
 185     (apply orig-func args)))
 186
 187 (defun ofw-move-to-other-window ()
 188   "Move current buffer to another window in same frame.
 189 Point stays in moved buffer."
 190   (interactive)
 191   (let ((buffer (current-buffer)))
 192     (switch-to-prev-buffer nil 'bury)
 193     (pop-to-buffer
 194      buffer
 195      (cons '(display-buffer-use-some-frame display-buffer-pop-up-window)
 196            (list (cons 'frame-predicate (lambda (frame) (eq frame (selected-frame))))
 197                  '(inhibit-same-window . t)))
 198      )))
 199
 200 (defun ofw-move-to-other-frame ()
 201   "Move current buffer to a window in another frame.
 202 Point stays in moved buffer."
 203   (interactive)
 204   (let ((buffer (current-buffer)))
 205     (switch-to-prev-buffer nil 'bury)
 206     (pop-to-buffer
 207      buffer
 208      (cons '(display-buffer-use-some-frame display-buffer-pop-up-frame)
 209            '((reusable-frames . visible)))
 210      )))
 211
 212 (defvar other-frame-window-mode-map
 213   (let ((map (make-sparse-keymap)))
 214     (define-key map "\C-x7" #'ofw-other-window)
 215     (define-key map "\C-x9" #'ofw-other-frame)
 216     (define-key map "\C-xW" #'ofw-move-to-other-window)
 217     (define-key map "\C-xF" #'ofw-move-to-other-frame)
 218     map)
 219   "Local keymap used for other-frame-window minor mode.")
 220
 221 (defun ofw--reset-prefix ()
 222   (if ofw--just-set
 223       (setq ofw--just-set nil)
 224     (ofw-delete-from-overriding)))
 225
 226 ;;;###autoload
 227 (define-minor-mode other-frame-window-mode
 228   "Minor mode for other frame/window buffer placement.
 229 Enable mode if ARG is positive."
 230   :global t
 231
 232   (remove-hook 'pre-command-hook #'ofw--reset-prefix)
 233
 234   (if other-frame-window-mode
 235       ;; enable
 236       (progn
 237         (add-hook 'pre-command-hook #'ofw--reset-prefix)
 238
 239         ;; We assume Emacs code calls pop-to-buffer when there is a good
 240         ;; reason to put the buffer in another window, so we don't mess
 241         ;; with the default actions, except to allow
 242         ;; display-buffer-reuse-window to use a window in another frame;
 243         ;; add (reusable-frames . visible) to display-buffer-base-action
 244         ;; attributes alist.
 245         (let ((functions (car display-buffer-base-action))
 246               (attrs (cdr display-buffer-base-action)))
 247           (push '(reusable-frames . visible) attrs)
 248           (setq display-buffer-base-action (cons functions attrs)))
 249
 250         ;; Change switch-to-buffer to use display-buffer
 251         (advice-add 'switch-to-buffer :around #'ofw-switch-to-buffer-advice)
 252
 253         ;; Completing-read <tab> pops up a buffer listing completions;
 254         ;; that should not respect or consume
 255         ;; ofw-frame-window-prefix-arg.
 256         (advice-add 'read-from-minibuffer :around #'ofw--suspend-and-restore)
 257         )
 258
 259     ;; else disable
 260     (let ((functions (car display-buffer-base-action))
 261           (attrs (cdr display-buffer-base-action)))
 262       (setq attrs (delq '(reusable-frames . visible) attrs))
 263       (setq display-buffer-base-action (cons functions attrs)))
 264
 265     (advice-remove 'switch-to-buffer #'ofw-switch-to-buffer-advice)
 266     (advice-remove 'read-from-minibuffer #'ofw--suspend-and-restore)
 267     ))
 268
 269 (unless (fboundp 'display-buffer-use-some-frame)
 270   ;; in Emacs 25; define here for earlier
 271
 272 (defun display-buffer-use-some-frame (buffer alist)
 273   "Display BUFFER in an existing frame that meets a predicate
 274 \(by default any frame other than the current frame).  If
 275 successful, return the window used; otherwise return nil.
 276
 277 If ALIST has a non-nil `inhibit-switch-frame' entry, avoid
 278 raising the frame.
 279
 280 If ALIST has a non-nil `frame-predicate' entry, its value is a
 281 function taking one argument (a frame), returning non-nil if the
 282 frame is a candidate; this function replaces the default
 283 predicate.
 284
 285 If ALIST has a non-nil `inhibit-same-window' entry, avoid using
 286 the currently selected window (only useful with a frame-predicate
 287 that allows the selected frame)."
 288   (let* ((predicate (or (cdr (assq 'frame-predicate alist))
 289                         (lambda (frame)
 290                           (and
 291                            (not (eq frame (selected-frame)))
 292                            (not (window-dedicated-p
 293                                  (or
 294                                   (get-lru-window frame)
 295                                   (frame-first-window frame)))))
 296                           )))
 297          (frame (car (filtered-frame-list predicate)))
 298          (window (and frame (get-lru-window frame nil (cdr (assq 'inhibit-same-window alist))))))
 299     (when window
 300       (prog1
 301           (window--display-buffer
 302            buffer window 'frame alist display-buffer-mark-dedicated)
 303         (unless (cdr (assq 'inhibit-switch-frame alist))
 304           (window--maybe-raise-frame frame))))
 305     ))
 306   )
 307
 308 ;; Some of the commands on the transient keymap don't actually *display*
 309 ;; in another window/frame but instead do something either at the level
 310 ;; of windows or frames.  I call those "ofw-dwim-*".
 311
 312 (defun ofw-dwim--frame-p ()
 313   "Return non-nil if the prefix is for \"other-frame\" rather than window."
 314   ;; IMPROVEME: Comparing functions is ugly/hackish!
 315   (memq #'ofw-display-buffer-other-frame
 316         (car display-buffer-overriding-action)))
 317
 318 (defun ofw-dwim-delete-this ()
 319   "Delete this frame or window."
 320   (interactive)
 321   (call-interactively
 322    (if (ofw-dwim--frame-p) #'delete-frame #'kill-buffer-and-window)))
 323
 324 (defun ofw-dwim-one ()
 325   "Delete all other frames or windows."
 326   (interactive)
 327   (call-interactively
 328    (if (ofw-dwim--frame-p) #'delete-other-frames #'delete-other-windows)))
 329
 330 (defun ofw-dwim-open-other ()
 331   "Show current buffer in other frame or window."
 332   (interactive)
 333   (if (ofw-dwim--frame-p)
 334       ;; IMPROVEME: This is the old C-x 5 2 behavior, but maybe it should just use
 335       ;; display-buffer instead!
 336       (call-interactively #'make-frame-command)
 337     (display-buffer (current-buffer))))
 338
 339 (defun ofw-dwim-select-other ()
 340   "Select other frame or window."
 341   (interactive)
 342   (call-interactively (if (ofw-dwim--frame-p) #'other-frame #'other-window)))
 343
 344 (provide 'other-frame-window)
 345 ;;; other-frame-window.el ends here