code.delx.au - gnu-emacs-elpa/blob - packages/wconf/wconf.el

   1 ;;; wconf.el --- Minimal window layout manager   -*- lexical-binding: t; -*-
   2
   3 ;; Copyright (C) 2014-2015  Free Software Foundation, Inc.
   4
   5 ;; Author: Ingo Lohmar <i.lohmar@gmail.com>
   6 ;; URL: https://github.com/ilohmar/wconf
   7 ;; Version: 0.2.0
   8 ;; Keywords: windows, frames, layout
   9 ;; Package-Requires: ((emacs "24.4"))
  10
  11 ;; This file is part of GNU Emacs.
  12
  13 ;; This program 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 ;; This program 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 ;; See the file README.org
  29
  30 ;;; Code:
  31
  32 (defgroup wconf nil
  33   "Easily use several window configurations."
  34   :group 'convenience)
  35
  36 (defcustom wconf-change-config-function #'wconf-change-config-default
  37   "Function called with current config whenever it is set."
  38   :group 'wconf)
  39
  40 (defcustom wconf-file (expand-file-name "wconf-window-configs.el"
  41                                         user-emacs-directory)
  42   "File used to save and load window configurations."
  43   :group 'wconf)
  44
  45 (defcustom wconf-fallback-buffer-name "*scratch*"
  46   "Name of the buffer to substitute for buffers which are not available."
  47   :group 'wconf)
  48
  49 (defcustom wconf-no-configs-string "-----"
  50   "String to use if there are no configurations at all."
  51   :group 'wconf)
  52
  53 (defcustom wconf-no-config-name "---"
  54   "String to use for the empty window configuration."
  55   :group 'wconf)
  56
  57 ;; internal variables and helper functions
  58
  59 (defvar wconf--configs nil
  60   "List of configurations; each item a list (active stored name).")
  61
  62 (defvar wconf--index nil
  63   "Index of currently shown configuration.  After clean and load
  64 this can be nil although wconf--configs is not empty.")
  65
  66 (defvar wconf-string nil
  67   "String representing information on the current configuration.")
  68
  69 (require 'cl-lib)
  70
  71 (defsubst wconf--ensure-configs (&optional current)
  72   (unless wconf--configs
  73     (error "wconf: No window configurations"))
  74   (when (and current (not wconf--index))
  75     (error "wconf: No window configuration is currently used")))
  76
  77 (defsubst wconf--ensure-index (&optional index)
  78   (unless (<= 0 index (1- (length wconf--configs)))
  79     (error "wconf: No window configuration index %s" index)))
  80
  81 (defun wconf--current-config ()
  82   (window-state-get (frame-root-window (selected-frame))
  83                     'writable))
  84
  85 (defun wconf- (index)
  86   (nth index wconf--configs))
  87
  88 (defun wconf--to-string (index)
  89   (if index
  90       (format "%s:%s"
  91               (number-to-string index)
  92               (cl-caddr (wconf- index)))
  93     (concat "-:" wconf-no-config-name)))
  94
  95 (defun wconf--update-info ()
  96   (when (functionp wconf-change-config-function)
  97     (funcall wconf-change-config-function
  98              ;; both will be nil if no list
  99              wconf--index
 100              (and wconf--index
 101                   (car (wconf- wconf--index))))))
 102
 103 (defun wconf--update-active-config ()
 104   (when wconf--index
 105     (setf (car (wconf- wconf--index)) (wconf--current-config))))
 106
 107 (defun wconf--use-config (index)
 108   (setq wconf--index index)
 109   (window-state-put (car (wconf- wconf--index))
 110                     (frame-root-window (selected-frame))
 111                     'safe)
 112   (wconf--update-info))
 113
 114 (defun wconf--reset ()
 115   "Remove all configurations."
 116   (setq wconf--configs nil)
 117   (setq wconf--index nil)
 118   (wconf--update-info))
 119
 120 (defun wconf--copy (wc)
 121   "Return a deep copy of WC, using `copy-tree'."
 122   (copy-tree wc t))
 123
 124 ;; global stuff
 125
 126 (defun wconf-change-config-default (index config)
 127   "Update `wconf-string' to represent configuration CONFIG at
 128 position INDEX."
 129   (setq wconf-string (if wconf--configs
 130                          (wconf--to-string index)
 131                        wconf-no-configs-string))
 132   (force-mode-line-update))
 133
 134 (defun wconf-save (&optional filename)
 135   "Save stored configurations in FILENAME, defaults to
 136 `wconf-file'."
 137   (interactive "F")
 138   (let ((filename (or filename wconf-file)))
 139     (with-temp-file filename
 140       (prin1 (mapcar #'cdr wconf--configs) ;-> (wc name)
 141              (current-buffer)))
 142     (message "wconf: Save stored configurations in %s" filename)))
 143
 144 (defun wconf--sanitize-buffer (b)
 145   (unless (get-buffer (cadr b))
 146     (setf (cadr b) wconf-fallback-buffer-name
 147           (cdr (assoc 'start b)) 1
 148           (cdr (assoc 'point b)) 1
 149           (cdr (assoc 'dedicated b)) nil)))
 150
 151 (defun wconf--sanitize-window-tree (node)
 152   (let ((buf (assoc 'buffer node)))
 153     (if buf                             ;in a leaf already
 154         (wconf--sanitize-buffer buf)
 155       (mapc (lambda (x)
 156               (when (and (consp x)
 157                          (memq (car x) '(leaf vc hc)))
 158                 (wconf--sanitize-window-tree (cdr x))))
 159             node))))
 160
 161 ;;;###autoload
 162 (defun wconf-load (&optional filename)
 163   "Load stored configurations from FILENAME, defaults to
 164 `wconf-file'."
 165   (interactive "f")
 166   (let ((filename (or filename wconf-file)))
 167     (unless (file-readable-p filename)
 168       (error "wconf: Cannot read file %s" filename))
 169     (wconf--reset)
 170     (with-temp-buffer
 171       (insert-file-contents filename)
 172       (goto-char (point-min))
 173       (setq wconf--configs
 174             (mapcar
 175              (lambda (f)                ;(wc name)
 176                (wconf--sanitize-window-tree (car f))
 177                (cons (wconf--copy (car f)) f))
 178              (read (current-buffer)))))
 179     (message "wconf: Load stored configurations from %s" filename))
 180   (wconf--update-info))
 181
 182 ;; these functions affect the whole list of configs
 183
 184 ;;;###autoload
 185 (defun wconf-create (&optional new)
 186   "Clone the current configuration or create a new \"empty\" one.
 187 The new configuration is appended to the list and becomes active.
 188
 189 With optional prefix argument NEW, or if there are no
 190 configurations yet, create a new configuration from the current
 191 window config."
 192   (interactive "P")
 193   (wconf--update-active-config)
 194   (setq wconf--configs
 195         (append wconf--configs
 196                 (list
 197                  (if (or new (not wconf--configs))
 198                      (progn
 199                        (message "wconf: Created new configuration %s"
 200                                 (length wconf--configs))
 201                        (list (wconf--current-config)
 202                              (wconf--current-config)
 203                              "new"))
 204                    (wconf--ensure-configs 'current)
 205                    (let ((wc (wconf- wconf--index)))
 206                      (message "wconf: Cloned configuration %s"
 207                               (wconf--to-string wconf--index))
 208                      (list (wconf--copy (car wc))
 209                            (wconf--copy (cadr wc))
 210                            (cl-caddr wc)))))))
 211   (wconf--use-config (1- (length wconf--configs))))
 212
 213 (defun wconf-kill ()
 214   "Kill current configuration."
 215   (interactive)
 216   (wconf--ensure-configs 'current)
 217   (let ((old-string (wconf--to-string wconf--index)))
 218     (setq wconf--configs
 219           (append (butlast wconf--configs
 220                            (- (length wconf--configs) wconf--index))
 221                   (last wconf--configs
 222                         (- (length wconf--configs) wconf--index 1))))
 223     (if wconf--configs
 224         (wconf--use-config (if (< (1- (length wconf--configs)) wconf--index)
 225                                (1- wconf--index)
 226                              wconf--index))
 227       (wconf--reset)
 228       (wconf--update-info))
 229     (message "wconf: Killed configuration %s" old-string)))
 230
 231 (defun wconf-swap (i j)
 232   "Swap configurations at positions I and J."
 233   (interactive
 234    (progn
 235      (wconf--ensure-configs 'current)   ;interactive?  then want current config
 236      (list
 237       wconf--index
 238       (read-number "Swap current config with index: "))))
 239   (wconf--ensure-configs)
 240   (wconf--ensure-index i)
 241   (wconf--ensure-index j)
 242   (wconf--update-active-config)
 243   (let ((wc (wconf- i)))
 244     (setf (nth i wconf--configs) (wconf- j))
 245     (setf (nth j wconf--configs) wc))
 246   (when (memq wconf--index (list i j))
 247     (wconf--use-config wconf--index))
 248   (message "wconf: Swapped configurations %s and %s"
 249            (number-to-string i) (number-to-string j)))
 250
 251 ;; manipulate single config
 252
 253 (defun wconf-rename (name)
 254   "Rename current configuration to NAME."
 255   (interactive
 256    (progn
 257      (wconf--ensure-configs 'current)
 258      (list
 259       (read-string "New window configuration name: "
 260                    (cl-caddr (wconf- wconf--index))))))
 261   (wconf--ensure-configs 'current)
 262   (setf (cl-caddr (wconf- wconf--index)) name)
 263   (message "wconf: Renamed configuration to \"%s\"" name)
 264   (wconf--update-info))
 265
 266 ;; interaction b/w stored and active configs
 267
 268 ;; these commands only make sense when there are wconf--configs, and
 269 ;; after wconf--index has become non-nil
 270
 271 (defsubst wconf--store (wc)
 272   (setf (cadr wc) (wconf--copy (car wc))))
 273
 274 (defsubst wconf--restore (wc)
 275   (setf (car wc) (wconf--copy (cadr wc))))
 276
 277 (defun wconf-store ()
 278   "Store currently active configuration."
 279   (interactive)
 280   (wconf--ensure-configs 'current)
 281   (wconf--update-active-config)
 282   (wconf--store (wconf- wconf--index))
 283   (message "wconf: Stored configuration %s" (wconf--to-string wconf--index)))
 284
 285 (defun wconf-store-all ()
 286   "Store all active configurations."
 287   (interactive)
 288   (wconf--ensure-configs 'current)
 289   (wconf--update-active-config)
 290   (mapc #'wconf--store wconf--configs)
 291   (message "wconf: Stored all configurations"))
 292
 293 (defun wconf-restore ()
 294   "Restore stored configuration."
 295   (interactive)
 296   (wconf--ensure-configs 'current)
 297   (wconf--restore (wconf- wconf--index))
 298   (wconf--use-config wconf--index)
 299   (message "wconf: Restored configuration %s" (wconf--to-string wconf--index)))
 300
 301 (defun wconf-restore-all ()
 302   "Restore all stored configurations."
 303   (interactive)
 304   (wconf--ensure-configs 'current)
 305   (mapc #'wconf--restore wconf--configs)
 306   (wconf--use-config wconf--index)
 307   (message "wconf: Restored all configurations"))
 308
 309 ;; change config
 310
 311 (defun wconf-switch-to-config (index &optional force)
 312   "Change to current config INDEX."
 313   (interactive "P")
 314   (wconf--ensure-configs)
 315   (let ((index (or index
 316                    (read-number "Switch to config number: "))))
 317     (wconf--ensure-index index)
 318     ;; remember active config (w/o name etc)
 319     (wconf--update-active-config)
 320     ;; maybe use new configuration
 321     (if (and (eq wconf--index index)
 322              (not force))
 323         (message "wconf: Nothing to do")
 324       (wconf--use-config index)
 325       (message "wconf: Switched to configuration %s"
 326                (wconf--to-string index)))))
 327
 328 (defun wconf-use-previous ()
 329   "Switch to previous window configuration."
 330   (interactive)
 331   (wconf--ensure-configs)
 332   (wconf-switch-to-config (mod (1- (or wconf--index 1))
 333                                (length wconf--configs))))
 334
 335 (defun wconf-use-next ()
 336   "Switch to next window configuration."
 337   (interactive)
 338   (wconf--ensure-configs)
 339   (wconf-switch-to-config (mod (1+ (or wconf--index -1))
 340                                (length wconf--configs))))
 341
 342 (provide 'wconf)
 343 ;;; wconf.el ends here