bmag / emacs-purpose / 9

;;; window-purpose-x.el --- Extensions for Purpose -*- lexical-binding: t -*-

;; Copyright (C) 2015-2018 Bar Magal & contributors

;; Author: Bar Magal

;; Package: purpose

;; This file is not part of GNU Emacs.

;; This program 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.

;; This program 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 this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:

;; File containing extensions for Purpose.

;; Extensions included:

;; - code1: 4-window display: main edit window, `dired' side window,

;;   `ibuffer' side window and `imenu-list' side window.

;; - magit: purpose configurations for magit.

;; - golden-ratio: make `golden-ratio-mode' work correctly with Purpose.

;; - popup-switcher: command `purpose-x-psw-switch-buffer-with-purpose'

;;   uses `popup-switcher' to switch to another buffer with the same

;;   purpose as the current buffer

;; - popwin: extension that emulates popwin's behavior.

;; - persp: extension to attach purpose configurations to perspectives.

;;   also provides commands such as `purpose-x-persp-switch-buffer'.

;;; Code:

(require 'window-purpose)

;;; --- purpose-x-code1 ---

;;; purpose-x-code1 extension creates a 4-window display:

;;; 1 main window for code buffers (purpose 'edit)

;;; 3 sub windows:

;;; - dired window: show directory of current buffer

;;; - ibuffer window: show currently open files

;;; - imenu-list window: show imenu of current buffer

(require 'dired)

(require 'ibuffer)

(require 'ibuf-ext)

(require 'imenu-list)

(defvar purpose-x-code1--window-layout

  '(nil

    (0 0 152 35)

    (t

     (0 0 29 35)

     (:purpose dired :purpose-dedicated t :width 0.16 :height 0.5 :edges

               (0.0 0.0 0.19333333333333333 0.5))

     (:purpose buffers :purpose-dedicated t :width 0.16 :height 0.4722222222222222 :edges

               (0.0 0.5 0.19333333333333333 0.9722222222222222)))

    (:purpose edit :purpose-dedicated t :width 0.6 :height 0.9722222222222222 :edges

              (0.19333333333333333 0.0 0.8266666666666667 0.9722222222222222))

    (:purpose ilist :purpose-dedicated t :width 0.15333333333333332 :height 0.9722222222222222 :edges

              (0.8266666666666667 0.0 1.0133333333333334 0.9722222222222222)))

  "Window layout for purpose-x-code1-dired-ibuffer.

Has a main 'edit window, and two side windows - 'dired and 'buffers.

All windows are purpose-dedicated.")

;; the name arg ("purpose-x-code1") is necessary for Emacs 24.5 and older

;; (omitting it produces an "Invalid slot name" error)

(defvar purpose-x-code1-purpose-config

  (purpose-conf "purpose-x-code1"

                :mode-purposes

                '((ibuffer-mode . buffers)

                  (dired-mode . dired)

                  (imenu-list-major-mode . ilist))))

(defvar purpose-x-code1-buffers-changed nil

  "Internal variable for use with `frame-or-buffer-changed-p'.")

(define-ibuffer-filter purpose-x-code1-ibuffer-files-only

    "Display only buffers that are bound to files."

  ()

  (buffer-file-name buf))

(defun purpose-x-code1--setup-ibuffer ()

  "Set up ibuffer settings."

  ;; not sure if we want this...

  ;; (setq ibuffer-default-shrink-to-minimum-size t)

(defun purpose-x-code1--unset-ibuffer ()

  "Unset ibuffer settings."

                                (name 18 18 :left :elide)

                                " "

                                (size 9 -1 :right)

                                " "

                                (mode 16 16 :left :elide)

                                " " filename-and-process)

                          (mark " "

                                (name 16 -1)

(defun purpose-x-code1-update-dired ()

  "Update free dired window with current buffer's directory.

If a non-buffer-dedicated window with purpose 'dired exists, display

the directory of the current buffer in that window, using `dired'.

If there is no window available, do nothing.

If current buffer doesn't have a filename, do nothing."

(defun purpose-x-code1-update-changed ()

  "Update auxiliary buffers if frame/buffer had changed.

Uses `frame-or-buffer-changed-p' to determine whether the frame or

buffer had changed."

;;;###autoload

(defun purpose-x-code1-setup ()

  "Setup purpose-x-code1.

This setup includes 4 windows:

1. dedicated 'edit window

2. dedicated 'dired window.  This window shows the current buffer's

directory in a special window, using `dired' and

`dired-hide-details-mode' (if available).

3. dedicated 'buffers window.  This window shows the currently open

files, using `ibuffer'.

4. dedicated 'ilist window.  This window shows the current buffer's

imenu."

  (interactive)

(defun purpose-x-code1-unset ()

  "Unset purpose-x-code1."

  (interactive)

;;; --- purpose-x-code1 ends here ---

;;; --- purpose-x-magit ---

;;; purpose-x-magit extension provides purpose configuration for magit.

;;; Two configurations available:

;;; - `purpose-x-magit-single-conf': all magit windows have the same purpose

;;;                                  ('Magit)

;;; - `purpose-x-magit-multi-conf': each magit major-mode has a seperate

;;;                                 purpose ('magit-status, 'magit-diff, ...)

;;; Use these commands to enable and disable magit's purpose configurations:

;;; - `purpose-x-magit-single-on'

;;; - `purpose-x-magit-multi-on'

;;; - `purpose-x-magit-off'

(defvar purpose-x-magit-single-conf

  (purpose-conf "magit-single"

                ;; using `magit' as a condition in

                ;; `purpose-special-action-sequences' is interpreted

                ;; as a predicate function (for buffer's without a

                ;; `magit' purpose). `Magit' doesn't have the same

                ;; problem (no function is named Magit), so that's why

                ;; we call the purpose `Magit' and not `magit'.

                :mode-purposes '((magit-mode . Magit)))

  "Configuration that gives each magit major mode the same purpose.")

(defvar purpose-x-magit-multi-conf

  (purpose-conf

   "magit-multi"

   :mode-purposes '((magit-diff-mode . magit-diff)

                    (magit-status-mode . magit-status)

                    (magit-log-mode . magit-log)

                    (magit-commit-mode . magit-commit)

                    (magit-cherry-mode . magit-cherry)

                    (magit-branch-manager-mode . magit-branch-manager)

                    (magit-process-mode . magit-process)

                    (magit-reflog-mode . magit-reflog)

                    (magit-wazzup-mode . magit-wazzup)))

  "Configuration that gives each magit major mode its own purpose.")

(defvar purpose-x-old-magit-display-buffer-function nil

  "Stores `magit-display-buffer-function'.

The value of `magit-display-buffer-function' at the time

`purpose-x-magit-single-on' or `purpose-x-magit-multi-on' is

invoked.")

(defun purpose-x-magit-display-buffer-function (buffer)

  "Integrate `magit' with `window-purpose'."

;;;###autoload

(defun purpose-x-magit-single-on ()

  "Turn on magit-single purpose configuration."

  (interactive)

;;;###autoload

(defun purpose-x-magit-multi-on ()

  "Turn on magit-multi purpose configuration."

  (interactive)

(defun purpose-x-magit-off ()

  "Turn off magit purpose configuration (single or multi)."

  (interactive)

;;; --- purpose-x-magit ends here ---

;;; --- purpose-x-golden-ration ---

;;; Make `purpose-mode' and `golden-ratio-mode' work together properly.

;;; Basically, this adds a hook to `purpose-select-buffer-hook' so

;;; `golden-ratio' is called when a buffer is selected via Purpose.

(defun purpose-x-sync-golden-ratio ()

  "Add/remove `golden-ratio' to `purpose-select-buffer-hook'.

Add `golden-ratio' at the end of `purpose-select-buffer-hook' if

`golden-ratio-mode' is on, otherwise remove it."

;;;###autoload

(defun purpose-x-golden-ratio-setup ()

  "Make `golden-ratio-mode' aware of `purpose-mode'."

  (interactive)

(defun purpose-x-golden-ratio-unset ()

  "Make `golden-ratio-mode' forget about `purpose-mode'."

  (interactive)

;;; --- purpose-x-golden-ration ends here ---

;;; --- purpose-x-popup-switcher ---

;;; A command for combinining `popup-switcher' with

;;; `purpose-switch-buffer-with-purpose'.

;;; This requires package `popup-switcher'

(when (require 'popup-switcher nil t)

  (defun purpose-x-psw-switch-buffer-with-purpose ()

    "Use `psw-switcher' to open another buffer with the current purpose."

    (interactive)

    (psw-switcher :items-list (purpose-buffers-with-purpose

                               (purpose-buffer-purpose (current-buffer)))

                  :item-name-getter #'buffer-name

                  :switcher #'purpose-switch-buffer)))

;;; --- purpose-x-popup-switcher ends here ---

;;; --- purpose-x-popwin ---

;;; An extension for displaying buffers in a temporary popup-window, similar

;;; to the `popwin' package.

(defcustom purpose-x-popwin-position 'bottom

  "Position for the popup window.

Legal values for this variable are 'top, 'bottom, 'left and 'right.  It

is also possible to set this variable to a function.  That function will

be used to create new popup windows and should be a display function

compatible with `display-buffer'."

  :group 'purpose

  :type '(choice (const top)

                 (const bottom)

                 (const left)

                 (const right)

                 function)

  :package-version '(window-purpose . "1.4"))

(defcustom purpose-x-popwin-width 0.4

  "Width of popup window when displayed at left or right.

Can have the same values as `purpose-display-at-left-width' and

`purpose-display-at-right-width'"

  :group 'purpose

  :type '(choice number

                 (const nil))

  :package-version '(window-purpose . "1.4"))

(defcustom purpose-x-popwin-height 0.35

  "Height of popup window when displayed at top or bottom.

Can have the same values as `purpose-display-at-top-height' and

`purpose-display-at-bottom-height'"

  :group 'purpose

  :type '(choice number

                 (const nil))

  :package-version '(window-purpose . "1.4"))

(defcustom purpose-x-popwin-major-modes '(help-mode

                                          compilation-mode

                                          occur-mode)

  "List of major modes that should be opened as popup windows.

When changing the value of this variable in elisp code, you should call

`purpose-x-popwin-update-conf' for the change to take effect."

  :group 'purpose

  :type '(repeat symbol)

  :set #'(lambda (symbol value)

           (prog1 (set-default symbol value)

             (purpose-x-popwin-update-conf)))

  :initialize 'custom-initialize-default

  :package-version '(window-purpose . "1.4"))

(defcustom purpose-x-popwin-buffer-names '("*Shell Command Output*")

  "List of buffer names that should be opened as popup windows.

Buffers whose name is contained in this list will be opened as popup

windows.

When changing the value of this variable in elisp code, you should call

`purpose-x-popwin-update-conf' for the change to take effect."

  :group 'purpose

  :type '(repeat string)

  :set #'(lambda (symbol value)

           (prog1 (set-default symbol value)

             (purpose-x-popwin-update-conf)))

  :initialize 'custom-initialize-default

  :package-version '(window-purpose . "1.4"))

(defcustom purpose-x-popwin-buffer-name-regexps nil

  "List of regexp that should be opened as popup windows.

Buffers whose name matches a regexp in this list will be opened as popup

windows.

When changing the value of this variable in elisp code, you should call

`purpose-x-popwin-update-conf' for the change to take effect."

  :group 'purpose

  :type '(repeat string)

  :set #'(lambda (symbol value)

           (prog1 (set-default symbol value)

             (purpose-x-popwin-update-conf)))

  :initialize 'custom-initialize-default

  :package-version '(window-purpose . "1.4"))

(defun purpose-x-popupify-purpose (purpose &optional display-fn)

  "Set up a popup-like behavior for buffers with purpose PURPOSE.

DISPLAY-FN is the display function to use for creating the popup window

for purpose PURPOSE, and defaults to `purpose-display-at-bottom'."

(defun purpose-x-unpopupify-purpose (purpose)

  "Remove popup-like behavior for buffers purpose PURPOSE.

This actually removes any special treatment for PURPOSE in

`purpose-special-action-sequences', not only popup-like behavior."

(defun purpose-x-popwin-update-conf ()

  "Update purpose-x-popwin's purpose configuration.

The configuration is updated according to

`purpose-x-popwin-major-modes', `purpose-x-popwin-buffer-names' and

`purpose-x-popwin-buffer-name-regexps'."

  (interactive)

                 "popwin"

(defun purpose-x-popwin-get-display-function ()

  "Return function for creating new popup windows.

The function is determined by the value of `purpose-x-popwin-position'."

        ('top 'purpose-display-at-top)

        ('bottom 'purpose-display-at-bottom)

        ('left 'purpose-display-at-left)

(defun purpose-x-popwin-display-buffer (buffer alist)

  "Display BUFFER in a popup window.

See `display-buffer' for the meaning of ALIST."

(defun purpose-x-popwin-close-windows ()

  "Delete all popup windows.

Internally, this function works be deleting all windows that have the

'popup purpose.  It also buried all popup buffers so they don't bother

the user when switching buffers."

  (interactive)

  ;; we bury all popup buffers, in case the user poped several popup buffers

  ;; (e.g. help and then occur), so all used popup buffers are buried

;; additional hooks we might want to use: `post-command-hook',

;; `post-self-insert-hook', `window-configuration-change-hook',

;; `buffer-list-update-hook'

(defun purpose-x-popwin-add-hooks ()

  "Set hooks for closing popup window automatically."

                  ;; using anonymous command so it's hidden from the user

                  (lambda ()

                    (interactive)

(defun purpose-x-popwin-remove-hooks ()

  "Remove hooks for closing popup window automatically.

This basically is an undo for `purpose-x-popwin-add-hooks'."

(defun purpose-x-popwin-stick ()

  "Prevent current popup window from being automatically closed.

To cancel, use `purpose-x-popwin-unstick'."

  (interactive)

(defun purpose-x-popwin-unstick ()

  "Allow current popup window to close automatically.

This is the opposite of `purpose-x-popwin-stick'."

  (interactive)

(defun purpose-x-popwin-closer-1 (&optional force)

  "Close popup window if appropriate, and remove hooks.

Closes the popup window if the selected window is not a popup window, a

helm window, or a minibuffer window.

If FORCE is non-nil, close popup window regardless to other conditions.

After closing the popup window, the relevant hooks are removed with

`purpose-x-popwin-remove-hooks'.  Note that the hooks are not removed if

the popup window doesn't need to close."

;;;###autoload

(defun purpose-x-popwin-setup ()

  "Activate `popwin' emulation.

This extension treats certain buffers as \"popup\" buffers and displays

them in a special popup window.

The window is closed automatically when selecting another buffer (via

`switch-to-buffer' and the like), or by pressing \\[keyboard-quit].

You can control which buffers are treated as popup buffers by changing

the variables `purpose-x-popwin-major-modes',

`purpose-x-popwin-buffer-names' and

`purpose-x-popwin-buffer-name-regexps'.

Look at `purpose-x-popwin-*' variables and functions to learn more."

  (interactive)

(defun purpose-x-popwin-unset ()

  "Deactivate `popwin' emulation."

  (interactive)

;;; --- purpose-x-popup ends here ---

;;; --- purpose-x-persp ---

;;; An extension for associating purpose configurations with perspectives.

;;; It activates and deactivates a :perspective purpose-conf extension

;;; automatically when switching perspectives or toggling `persp-mode'. It also

;;; provides switch-buffer commands for switching to a buffer with the same

;;; purpose and perspective as the current buffer

;;; (`purpose-x-persp-switch-buffer', `*-other-windw', `*-other-frame').

(defvar purpose-x-persp-confs (make-hash-table :test 'equal)

  "Hash table holding perspectives' purpose configurations.

The table maps a perspective's name to its purpose configuration.  A

perspective's name is a string (obviously), and its purpose

configuration is a `purpose-conf' object.

To add/remove entries, use:

  (puthash <name> <conf> purpose-x-persp-confs)

  (remhash <name> purpose-x-persp-confs)")

(defun purpose-x-persp-activate ()

  "Activate current perspective's purpose configuration."

(defun purpose-x-persp-remove ()

  "Remove current perspective's purpose configuration."

(defun purpose-x-persp-activate-or-remove ()

  "Activate/remove current perspective's purpose configuration.

Should be hooked to `persp-mode-hook'."

;;;###autoload

(defun purpose-x-persp-setup ()

  "Activate purpose-x-persp extension.

This extension automatically activates a purpose configuration for the

current perspective.  The configuration changes automatically when

switching perspectives or when toggling `persp-mode'.

The variable `purpose-x-persp-confs' matches between perspectives and

purpose configurations."

  (interactive)

(defun purpose-x-persp-unset ()

  "Deactivate purpose-x-persp extension."

  (interactive)

(defun purpose-x-persp-get-buffer-names ()

  "Get names of all buffers with same purpose and perspective as current buffer.

The returned list doesn't contain the current buffer."

;;;###autoload

(defun purpose-x-persp-switch-buffer (buffer &optional norecord force-same-window)

  "Switch to BUFFER, limited by purpose and perspective.

BUFFER is chosen from buffers with the same purpose as the current

buffer that are also part of the current perspective.

NORECORD and FORCE-SAME-WINDOW have the same meaning as in

`switch-to-buffer'."

  (interactive

                          nil

;;;###autoload

(defun purpose-x-persp-switch-buffer-other-window (buffer &optional norecord)

  "Switch to BUFFER in other window, limited by purpose and perspective.

NORECORD has the same meaning as in `switch-to-buffer-other-window'.

The relation between `purpose-x-persp-switch-buffer-other-window' and

`switch-to-buffer-other-window' is the same as the relation between

`purpose-x-persp-switch-buffer' and `switch-to-buffer'."

  (interactive

                          nil

;;;###autoload

(defun purpose-x-persp-switch-buffer-other-frame (buffer &optional norecord)

  "Switch to BUFFER in other frame, limited by purpose and perspective.

NORECORD has the same meaning as in `switch-to-buffer-other-frame'.

The relation between `purpose-x-persp-switch-buffer-other-frame' and

`switch-to-buffer-other-frame' is the same as the relation between

`purpose-x-persp-switch-buffer' and `switch-to-buffer'."

  (interactive

                          nil

;;; --- purpose-x-persp ends here ---

;;; --- purpose-x-kill ---

;;; an extensions that makes emacs respect purpose-dedicated window parameter

;;; when killing a buffer that is visible in a window.

;; copied from `replace-buffer-in-windows' and edited to respect the

;; purpose-dedicated window parameter

(defun purpose-x-replace-buffer-in-windows-1 (&optional buffer-or-name)

  "Replace BUFFER-OR-NAME with some other buffer in all windows showing it.

BUFFER-OR-NAME may be a buffer or the name of an existing buffer and

defaults to the current buffer.

When a window showing BUFFER-OR-NAME is buffer-dedicated, that window is

deleted.  If that window is the only window on its frame, the frame is

deleted too when there are other frames left.  If there are no other

frames left, some other buffer is displayed in that window.

When a window showing BUFFER-OR-NAME is purpose-dedicated, BUFFER-OR-NAME

is replaced with another buffer with the same purpose.  If there are no

other buffers with the same purpose, follow the same rules as if the

window was buffer-dedicated.

This function removes the buffer denoted by BUFFER-OR-NAME from all

window-local buffer lists."

  (interactive "bBuffer to replace: ")

         ;; Delay calculating other-buffers until we need it

         ;; This prevents unnecessary calculations on temporary

         ;; buffers created by `with-temp-buffer' and other likewise

         ;; non-displayed buffers

         (other-buffers-calculated nil)

         (other-buffers nil))

                ;; dedicated, so replace with a buffer with the same purpose

                ;; dedicated, but no other buffers with the same purpose, so

                ;; delete the window/frame

               (t

                ;; 1) not dedicated, or 2) dedicated and no other buffers with

                ;; the same purpose, but the window isn't deletable.

                ;; remove dedicated status and switch to previous buffer

        ;; Unrecord BUFFER in WINDOW.

(defun purpose-x-replace-buffer-in-windows (&optional buffer-or-name)

  "Override `replace-buffer-in-windows' with a purpose-aware version."

(defun purpose-x-kill-sync ()

  "Synchronize `replace-buffer-in-windows' with `purpose-mode'.

If `purpose-mode' is enabled, override `replace-buffer-in-windows' with

`purpose-x-replace-buffer-in-windows'.  If `purpose-mode' is disabled,

cancel the override of `replace-buffer-in-windows'."

;;;###autoload

(defun purpose-x-kill-setup ()

  "Activate purpose-x-kill extension.

This extension makes `kill-buffer' aware of the purpose-dedicated window

parameter, when killing a visible buffer.  If a buffer that is being

killed is displayed in a window,and that window is purpose-dedicated,

then try to replace the buffer with another buffer with the same purpose.

If that isn't possible, treat the window as if it was buffer-dedicated.

This is implemented by overriding `replace-buffer-in-windows' with

`purpose-x-replace-buffer-in-windows-1'.  See

`purpose-x-replace-buffer-in-windows-1' for more details."

  (interactive)

(defun purpose-x-kill-unset ()

  "Deactivate purpose-x-kill extension."

  (interactive)

;;; --- purpose-x-kill ends here ---

(provide 'window-purpose-x)

;;; window-purpose-x.el ends here