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.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 ;; - Make the `C-x 7' prefix appear in the echo area.
  58 ;; - `C-x 7 C-h' should display the transient map.
  59 ;; - `C-x 7 C-u foo' should pass both prefixes to `foo'.
  60
  61 ;;; Code:
  62
  63 (defvar ofw--just-set nil
  64   "Non-nil if we just set the prefix in the previous command.")
  65
  66 (defvar ofw-transient-map
  67   (let ((map (make-sparse-keymap)))
  68     ;; This is basically the union of the default C-x 4 and C-x 5
  69     ;; keymaps in Emacs-25.
  70     (define-key map [?\C-f] #'find-file)
  71     (define-key map [?\C-o] #'display-buffer)
  72     (define-key map [?.]
  73       (if (fboundp 'xref-find-definitions) ;Emacs≥25.
  74           'xref-find-definitions 'find-tag))
  75     (define-key map [?0] #'ofw-dwim-delete-this)
  76     (define-key map [?1] #'ofw-dwim-one)
  77     (define-key map [?2] #'ofw-dwim-open-other)
  78     (define-key map [?a] #'add-change-log-entry)
  79     (define-key map [?b] #'switch-to-buffer)
  80     (define-key map [?c] #'clone-indirect-buffer)
  81     (define-key map [?d] #'dired)
  82     (define-key map [?f] #'find-file)
  83     (define-key map [?m] #'compose-mail)
  84     (define-key map [?o] #'ofw-dwim-select-other)
  85     (define-key map [?r] #'find-file-read-only)
  86     map)
  87   "Keymap used for one command right after setting the prefix.")
  88
  89 (defun ofw--set-prefix (func)
  90   "Add ofw prefix function FUNC."
  91   (let ((functions (car display-buffer-overriding-action))
  92         (attrs (cdr display-buffer-overriding-action)))
  93     (push func functions)
  94     (setq display-buffer-overriding-action (cons functions attrs))
  95     ;; Make sure the next pre-command-hook doesn't immediately set
  96     ;; display-buffer-overriding-action back to nil.
  97     (setq ofw--just-set t)
  98     ;; C-u C-x 7 foo should pass C-u to foo, not to C-x 7, so
  99     ;; pass the normal prefix to the next command.
 100     ;; FIXME: This should be done by all prefix commands and for all kinds of
 101     ;; prefixes, so that C-x 7 C-u foo works as well!
 102     (setq prefix-arg current-prefix-arg)
 103     (set-transient-map ofw-transient-map)))
 104
 105 (defun ofw-delete-from-overriding ()
 106   "Remove ourselves from 'display-buffer-overriding-action' action list, if present."
 107   (let ((functions (car display-buffer-overriding-action))
 108         (attrs (cdr display-buffer-overriding-action)))
 109     (setq functions (delq #'ofw-display-buffer-other-frame
 110                           (delq #'ofw-display-buffer-other-window functions)))
 111     (setq display-buffer-overriding-action
 112           (when (or functions attrs) (cons functions attrs)))))
 113
 114 (defun ofw-other-window ()
 115   "Set `display-buffer-overriding-action' to indicate other window."
 116   (interactive)
 117   (ofw--set-prefix #'ofw-display-buffer-other-window))
 118
 119 (defun ofw-other-frame ()
 120   "Set `display-buffer-overriding-action' to indicate other frame."
 121   (interactive)
 122   (ofw--set-prefix #'ofw-display-buffer-other-frame))
 123
 124 (defun ofw-display-buffer-other-window (buffer alist)
 125   "Show BUFFER in another window in the current frame,
 126 creating new window if needed and allowed.
 127 If successful, return window; else return nil.
 128 Intended for 'display-buffer-overriding-action'."
 129   ;; Reset for next display-buffer call.  Normally, this is taken care
 130   ;; of by ofw--reset-prefix, but we do it here in case the user does
 131   ;; two ofw prefixed commands consecutively.
 132   (ofw-delete-from-overriding)
 133
 134   ;; We can't use display-buffer-use-some-window here, because
 135   ;; that unconditionally allows another frame.
 136   (or (display-buffer-use-some-frame
 137        buffer
 138        (append (list (cons 'frame-predicate
 139                            (lambda (frame) (eq frame (selected-frame))))
 140                      '(inhibit-same-window . t))
 141                alist))
 142       (display-buffer-pop-up-window buffer alist)))
 143
 144 (defun ofw-display-buffer-other-frame (buffer alist)
 145   "Show BUFFER in another frame, creating a new frame if needed.
 146 If successful, return window; else return nil.
 147 Intended for 'display-buffer-overriding-action'."
 148   ;; Reset for next display-buffer call.
 149   (ofw-delete-from-overriding)
 150
 151   (or (display-buffer-use-some-frame buffer alist)
 152       (display-buffer-pop-up-frame buffer alist)))
 153
 154 ;; FIXME: use defadvice for Emacs 24.3
 155 (defun ofw-switch-to-buffer-advice (orig-fun buffer
 156                                     &optional norecord force-same-window)
 157   "Change `switch-to-buffer' to call `pop-to-buffer'.
 158 This allows `switch-to-buffer' to respect `ofw-other-window',
 159 `ofw-other-frame'."
 160   (if display-buffer-overriding-action
 161       (pop-to-buffer buffer (list #'display-buffer-same-window) norecord)
 162     (funcall orig-fun buffer norecord force-same-window)))
 163
 164 ;; FIXME: use defadvice for Emacs 24.3
 165 (defun ofw--suspend-and-restore (orig-func &rest args)
 166   "Call ORIG-FUNC without any ofw actions on 'display-buffer-overriding-action'."
 167   (let ((display-buffer-overriding-action display-buffer-overriding-action))
 168     ;; FIXME: ofw-delete-from-overriding operates destructively, so the
 169     ;; subsequent "restore" step only works if our ofw actions were all at the
 170     ;; very beginning display-buffer-overriding-action (in which case `delq'
 171     ;; happens not to be destructive).
 172     (ofw-delete-from-overriding)
 173     (apply orig-func args)))
 174
 175 (defun ofw-move-to-other-window ()
 176   "Move current buffer to another window in same frame.
 177 Point stays in moved buffer."
 178   (interactive)
 179   (let ((buffer (current-buffer)))
 180     (switch-to-prev-buffer nil 'bury)
 181     (pop-to-buffer
 182      buffer
 183      (cons '(display-buffer-use-some-frame display-buffer-pop-up-window)
 184            (list (cons 'frame-predicate (lambda (frame) (eq frame (selected-frame))))
 185                  '(inhibit-same-window . t)))
 186      )))
 187
 188 (defun ofw-move-to-other-frame ()
 189   "Move current buffer to a window in another frame.
 190 Point stays in moved buffer."
 191   (interactive)
 192   (let ((buffer (current-buffer)))
 193     (switch-to-prev-buffer nil 'bury)
 194     (pop-to-buffer
 195      buffer
 196      (cons '(display-buffer-use-some-frame display-buffer-pop-up-frame)
 197            '((reusable-frames . visible)))
 198      )))
 199
 200 (defvar other-frame-window-mode-map
 201   (let ((map (make-sparse-keymap)))
 202     (define-key map "\C-x7" #'ofw-other-window)
 203     (define-key map "\C-x9" #'ofw-other-frame)
 204     (define-key map "\C-xW" #'ofw-move-to-other-window)
 205     (define-key map "\C-xF" #'ofw-move-to-other-frame)
 206     map)
 207   "Local keymap used for other-frame-window minor mode.")
 208
 209 (defun ofw--reset-prefix ()
 210   (if ofw--just-set
 211       (setq ofw--just-set nil)
 212     (ofw-delete-from-overriding)))
 213
 214 (define-minor-mode other-frame-window-mode
 215   "Minor mode for other frame/window buffer placement.
 216 Enable mode if ARG is positive."
 217   :global t
 218
 219   (remove-hook 'pre-command-hook #'ofw--reset-prefix)
 220
 221   (if other-frame-window-mode
 222       ;; enable
 223       (progn
 224         (add-hook 'pre-command-hook #'ofw--reset-prefix)
 225
 226         ;; We assume Emacs code calls pop-to-buffer when there is a good
 227         ;; reason to put the buffer in another window, so we don't mess
 228         ;; with the default actions, except to allow
 229         ;; display-buffer-reuse-window to use a window in another frame;
 230         ;; add (reusable-frames . visible) to display-buffer-base-action
 231         ;; attributes alist.
 232         (let ((functions (car display-buffer-base-action))
 233               (attrs (cdr display-buffer-base-action)))
 234           (push '(reusable-frames . visible) attrs)
 235           (setq display-buffer-base-action (cons functions attrs)))
 236
 237         ;; Change switch-to-buffer to use display-buffer
 238         (if (fboundp 'advice-add) ;Emacs≥24.4
 239             (advice-add 'switch-to-buffer :around #'ofw-switch-to-buffer-advice)
 240           ;; FIXME: `ad-activate' affects all pieces of advice of that
 241           ;; function, which is not what we want!
 242           ;; (ad-activate 'switch-to-buffer)
 243           )
 244
 245         ;; Completing-read <tab> pops up a buffer listing completions;
 246         ;; that should not respect or consume
 247         ;; ofw-frame-window-prefix-arg.
 248         (if (fboundp 'advice-add)
 249             (advice-add 'read-from-minibuffer
 250                         :around #'ofw--suspend-and-restore)
 251           ;; FIXME: `ad-activate' affects all pieces of advice of that
 252           ;; function, which is not what we want!
 253           ;; (ad-activate 'read-from-minibuffer)
 254           )
 255         )
 256
 257     ;; else disable
 258     (let ((functions (car display-buffer-base-action))
 259           (attrs (cdr display-buffer-base-action)))
 260       (setq attrs (delq '(reusable-frames . visible) attrs))
 261       (setq display-buffer-base-action (cons functions attrs)))
 262
 263     (advice-remove 'switch-to-buffer #'ofw-switch-to-buffer-advice)
 264     (advice-remove 'read-from-minibuffer #'ofw--suspend-and-restore)
 265     ))
 266
 267 (unless (fboundp 'display-buffer-use-some-frame)
 268   ;; in Emacs 25; define here for earlier
 269
 270 (defun display-buffer-use-some-frame (buffer alist)
 271   "Display BUFFER in an existing frame that meets a predicate
 272 \(by default any frame other than the current frame).  If
 273 successful, return the window used; otherwise return nil.
 274
 275 If ALIST has a non-nil `inhibit-switch-frame' entry, avoid
 276 raising the frame.
 277
 278 If ALIST has a non-nil `frame-predicate' entry, its value is a
 279 function taking one argument (a frame), returning non-nil if the
 280 frame is a candidate; this function replaces the default
 281 predicate.
 282
 283 If ALIST has a non-nil `inhibit-same-window' entry, avoid using
 284 the currently selected window (only useful with a frame-predicate
 285 that allows the selected frame)."
 286   (let* ((predicate (or (cdr (assq 'frame-predicate alist))
 287                         (lambda (frame)
 288                           (and
 289                            (not (eq frame (selected-frame)))
 290                            (not (window-dedicated-p
 291                                  (or
 292                                   (get-lru-window frame)
 293                                   (frame-first-window frame)))))
 294                           )))
 295          (frame (car (filtered-frame-list predicate)))
 296          (window (and frame (get-lru-window frame nil (cdr (assq 'inhibit-same-window alist))))))
 297     (when window
 298       (prog1
 299           (window--display-buffer
 300            buffer window 'frame alist display-buffer-mark-dedicated)
 301         (unless (cdr (assq 'inhibit-switch-frame alist))
 302           (window--maybe-raise-frame frame))))
 303     ))
 304   )
 305
 306 ;; Some of the commands on the transient keymap don't actually *display*
 307 ;; in another window/frame but instead do something either at the level
 308 ;; of windows or frames.  I call those "ofw-dwim-*".
 309
 310 (defun ofw-dwim--frame-p ()
 311   "Return non-nil if the prefix is for \"other-frame\" rather than window."
 312   ;; FIXME: Comparing functions is ugly/hackish!
 313   (memq #'ofw-display-buffer-other-frame
 314         (car display-buffer-overriding-action)))
 315
 316 (defun ofw-dwim-delete-this ()
 317   "Delete this frame or window."
 318   (interactive)
 319   (call-interactively
 320    (if (ofw-dwim--frame-p) #'delete-frame #'kill-buffer-and-window)))
 321
 322 (defun ofw-dwim-one ()
 323   "Delete all other frames or windows."
 324   (interactive)
 325   (call-interactively
 326    (if (ofw-dwim--frame-p) #'delete-other-frames #'delete-other-windows)))
 327
 328 (defun ofw-dwim-open-other ()
 329   "Show current buffer in other frame or window."
 330   (interactive)
 331   (if (ofw-dwim--frame-p)
 332       ;; FIXME: This is the old C-x 5 2 behavior, but maybe it should just use
 333       ;; display-buffer instead!
 334       (call-interactively #'make-frame-command)
 335     (display-buffer (current-buffer))))
 336
 337 (defun ofw-dwim-select-other ()
 338   "Select other frame or window."
 339   (interactive)
 340   (call-interactively (if (ofw-dwim--frame-p) #'other-frame #'other-window)))
 341
 342 (provide 'other-frame-window)
 343 ;;; other-frame-window.el ends here