[elpa] externals/other-frame-window 58a1e66 01/16: * packages/other-frame-window/other-frame-window.el: New single-file package.

[Stefan Monnier]

branch: externals/other-frame-window
commit 58a1e664cfa718ae3c18c675c21ba0826e66a178
Author: Stephen Leake <stephen_leake@stephe-leake.org>
Commit: Stephen Leake <stephen_leake@stephe-leake.org>

    * packages/other-frame-window/other-frame-window.el: New single-file 
package.
---
 other-frame-window.el | 252 ++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 252 insertions(+)

diff --git a/other-frame-window.el b/other-frame-window.el
new file mode 100755
index 0000000..27dd8e2
--- /dev/null
+++ b/other-frame-window.el
@@ -0,0 +1,252 @@
+;;; minor mode to enable global prefix keys for other frame/window buffer 
placement -*- lexical-binding: t -*-
+;;
+;; Copyright (C) 2015  Free Software Foundation, Inc.
+;;
+;; Author: Stephen Leake <stephen_leake@member.fsf.org>
+;; Maintainer: Stephen Leake <stephen_leake@member.fsf.org>
+;; Keywords: frame
+;; window
+;; Version: 1.0.0
+;; package-requires: ((emacs "25.0"))
+;;
+;; This file is part of GNU Emacs.
+;;
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+;;
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+;;
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+;;
+;;; Usage:
+;;
+;; Enable the minor mode with:
+;;
+;; M-x other-frame-window-mode
+;;
+;; or, in your ~/.emacs:
+;;
+;; (other-frame-window-mode t)
+;;
+;; C-x 7 <command> causes a buffer displayed by <command> to appear in
+;; another window in the same frame; a window is created if necessary.
+;;
+;; C-x 9 <command> causes a buffer displayed by <command> to appear in
+;; another frame; a frame is created if necessary.
+
+;;; Design:
+;;
+;; This uses C-x 7, 9 prefix because those keys are undefined in core
+;; Emacs.  It could eventually switch to 4, 5, since those are
+;; currently used for -other-window, -other-frame bindings.
+;;
+;; (info "(emacs) Pop Up Window") (info "(emacs) Creating Frames")
+;;
+;; This adds advice to switch-to-buffer; eventually Emacs could
+;; reimplement switch-to-buffer to do the same.
+
+;;; Code:
+
+(defun ofw-add-to-overriding (func)
+  "Add FUNC to 'display-buffer-overriding-action' action list."
+  (let ((functions (car display-buffer-overriding-action))
+       (attrs (cdr display-buffer-overriding-action)))
+    (push func functions)
+    (setq display-buffer-overriding-action (cons functions attrs))))
+
+(defun ofw-delete-from-overriding ()
+  "Delete 'ofw-display-buffer-other-window' and
+'ofw-display-buffer-other-frame' from
+'display-buffer-overriding-action' action list, if present."
+    (let ((functions (car display-buffer-overriding-action))
+         (attrs (cdr display-buffer-overriding-action)))
+      (setq functions (delq 'ofw-display-buffer-other-frame (delq 
'ofw-display-buffer-other-window functions)))
+      (setq display-buffer-overriding-action (cons functions attrs))))
+
+(defun ofw-other-window ()
+  "Set `display-buffer-overriding-action' to indicate other window."
+  (interactive)
+  (ofw-add-to-overriding 'ofw-display-buffer-other-window))
+
+(defun ofw-other-frame ()
+  "Set `display-buffer-overriding-action' to indicate other frame."
+  (interactive)
+  (ofw-add-to-overriding 'ofw-display-buffer-other-frame))
+
+(defun ofw-display-buffer-other-window (buffer alist)
+  "Show BUFFER in another window in the current frame,
+creating new window if needed and allowed.
+If successful, return window; else return nil.
+Intended for 'display-buffer-overriding-action'."
+  ;; Reset for next display-buffer call. FIXME: C-g, and next command
+  ;; failure, should also reset this
+  (setq display-buffer-overriding-action nil)
+
+  ;; We can't use display-buffer-use-some-window here, because
+  ;; that unconditionally allows another frame.
+  (or (display-buffer-use-some-frame
+       buffer
+       (append (list (cons 'frame-predicate (lambda (frame) (eq frame 
(selected-frame))))
+                    '(inhibit-same-window . t))
+              alist))
+      (display-buffer-pop-up-window buffer alist)))
+
+(defun ofw-display-buffer-other-frame (buffer alist)
+  "Show BUFFER in another frame, creating a new frame
+if needed.
+If successful, return window; else return nil.
+Intended for 'display-buffer-overriding-action'."
+  ;; Reset for next display-buffer call.
+  (setq display-buffer-overriding-action nil)
+
+  (or (display-buffer-use-some-frame buffer alist)
+      (display-buffer-pop-up-frame buffer alist)))
+
+;; FIXME: use defadvice for Emacs 24.3
+(defun ofw-switch-to-buffer-advice (_orig-fun buffer  &optional norecord 
_force-same-window)
+  "Change switch-to-buffer to call pop-to-buffer.
+This allows switch-to-buffer to respect 'ofw-other-window',
+'ofw-other-frame'."
+  (pop-to-buffer buffer (list 'display-buffer-same-window) norecord))
+
+;; FIXME: use defadvice for Emacs 24.3
+(defun ofw-temp-window-advice (orig-func buffer &optional action)
+  "Delete any ofw actions from 'display-buffer-overriding-action',
+call ORIG-FUNC, restore ofw actions to 'display-buffer-overriding-action'."
+  (let ((temp display-buffer-overriding-action)
+       result)
+    (ofw-delete-from-overriding)
+    (setq result (funcall orig-func buffer action))
+    (setq display-buffer-overriding-action temp)
+    result))
+
+(defun ofw-move-to-other-window ()
+  "Move current buffer to another window in same frame.
+Point stays in moved buffer."
+  (interactive)
+  (let ((buffer (current-buffer)))
+    (switch-to-prev-buffer nil 'bury)
+    (pop-to-buffer
+     buffer
+     (cons '(display-buffer-use-some-frame display-buffer-pop-up-window)
+          (list (cons 'frame-predicate (lambda (frame) (eq frame 
(selected-frame))))
+                '(inhibit-same-window . t)))
+     )))
+
+(defun ofw-move-to-other-frame ()
+  "Move current buffer to a window in another frame.
+Point stays in moved buffer."
+  (interactive)
+  (let ((buffer (current-buffer)))
+    (switch-to-prev-buffer nil 'bury)
+    (pop-to-buffer
+     buffer
+     (cons '(display-buffer-use-some-frame display-buffer-pop-up-frame)
+          '((reusable-frames . visible)))
+     )))
+
+(defvar ofw-map
+  (let ((map (make-sparse-keymap)))
+    (define-key map "\C-x7" 'ofw-other-window)
+    (define-key map "\C-x9" 'ofw-other-frame)
+    (define-key map "\C-xW" 'ofw-move-to-other-window)
+    (define-key map "\C-xF" 'ofw-move-to-other-frame)
+    map
+  )  "Local keymap used for other-frame-window minor mode.")
+
+(define-minor-mode other-frame-window-mode
+  "Minor mode for other frame/window buffer placement.
+Enable mode if ARG is positive."
+  :init-value nil
+  :lighter    " ofw"   ;; mode line
+  :keymap     ofw-map
+  :global     t
+
+  (if other-frame-window-mode
+      ;; enable
+      (progn
+       ;; We assume Emacs code calls pop-to-buffer when there is a good
+       ;; reason to put the buffer in another window, so we don't mess
+       ;; with the default actions, except to allow
+       ;; display-buffer-reuse-window to use a window in another frame;
+       ;; add (reusable-frames . visible) to display-buffer-base-action
+       ;; attributes alist.
+       (let ((functions (car display-buffer-base-action))
+             (attrs (cdr display-buffer-base-action)))
+         (push '(reusable-frames . visible) attrs)
+         (setq display-buffer-base-action (cons functions attrs)))
+
+       ;; Change switch-to-buffer to use display-buffer
+       (if (fboundp 'advice-add)
+           ;; Emacs 25
+           (advice-add 'switch-to-buffer :around #'ofw-switch-to-buffer-advice)
+         ;; Emacs 24
+         (ad-activate 'switch-to-buffer))
+
+       ;; Completing-read <tab> pops up a buffer listing completions;
+       ;; that should not respect or consume
+       ;; ofw-frame-window-prefix-arg. We advise
+       ;; temp-buffer-window-show-advice (used by completing-read) to
+       ;; handle additional similar cases.
+       (if (fboundp 'advice-add)
+           (advice-add 'temp-buffer-window-show :around 
#'ofw-temp-window-advice)
+         (ad-activate 'temp-buffer-window-show))
+       )
+
+    ;; else disable
+    (let ((functions (car display-buffer-base-action))
+         (attrs (cdr display-buffer-base-action)))
+      (setq attrs (delq '(reusable-frames . visible) attrs))
+      (setq display-buffer-base-action (cons functions attrs)))
+
+    (advice-remove 'switch-to-buffer #'ofw-switch-to-buffer-advice)
+    (advice-remove 'temp-buffer-window-show 
#'ofw-temp-buffer-window-show-advice)
+    ))
+
+(unless (fboundp 'display-buffer-use-some-frame)
+  ;; in Emacs 25; define here for earlier
+
+(defun display-buffer-use-some-frame (buffer alist)
+  "Display BUFFER in an existing frame that meets a predicate
+\(by default any frame other than the current frame).  If
+successful, return the window used; otherwise return nil.
+
+If ALIST has a non-nil `inhibit-switch-frame' entry, avoid
+raising the frame.
+
+If ALIST has a non-nil `frame-predicate' entry, its value is a
+function taking one argument (a frame), returning non-nil if the
+frame is a candidate; this function replaces the default
+predicate.
+
+If ALIST has a non-nil `inhibit-same-window' entry, avoid using
+the currently selected window (only useful with a frame-predicate
+that allows the selected frame)."
+  (let* ((predicate (or (cdr (assq 'frame-predicate alist))
+                        (lambda (frame)
+                          (and
+                           (not (eq frame (selected-frame)))
+                           (not (window-dedicated-p
+                                 (or
+                                  (get-lru-window frame)
+                                  (frame-first-window frame)))))
+                          )))
+         (frame (car (filtered-frame-list predicate)))
+         (window (and frame (get-lru-window frame nil (cdr (assq 
'inhibit-same-window alist))))))
+    (when window
+      (prog1
+          (window--display-buffer
+           buffer window 'frame alist display-buffer-mark-dedicated)
+        (unless (cdr (assq 'inhibit-switch-frame alist))
+          (window--maybe-raise-frame frame))))
+    ))
+  )
+
+(provide 'other-frame-window)
+;; end of file