workgroups2 Changeset - d49e33f7e3f1

@@ -1754,792 +1754,790 @@ Adds entries to `minor-mode-list', `minor-mode-alist' and

   (kbd "C")          'wg-clone-workgroup

   (kbd "A")          'wg-rename-workgroup

   (kbd "C-'")        'wg-switch-to-workgroup

   (kbd "'")          'wg-switch-to-workgroup

   (kbd "C-v")        'wg-switch-to-workgroup

   (kbd "v")          'wg-switch-to-workgroup

   ;; session

   (kbd "C-s")        'wg-save-session

   (kbd "C-w")        'wg-save-session-as

   (kbd "C-f")        'wg-open-session

   ;; killing and yanking

   (kbd "C-k")        'wg-kill-workgroup

   (kbd "k")          'wg-kill-workgroup

   (kbd "M-W")        'wg-kill-ring-save-base-wconfig

   (kbd "M-w")        'wg-kill-ring-save-working-wconfig

   (kbd "C-y")        'wg-yank-wconfig

   (kbd "y")          'wg-yank-wconfig

   (kbd "M-k")        'wg-kill-workgroup-and-buffers

   (kbd "K")          'wg-delete-other-workgroups

   ;; workgroup switching

   (kbd "C-j")        'wg-switch-to-workgroup-at-index

   (kbd "j")          'wg-switch-to-workgroup-at-index

   (kbd "0")          'wg-switch-to-workgroup-at-index-0

   (kbd "1")          'wg-switch-to-workgroup-at-index-1

   (kbd "2")          'wg-switch-to-workgroup-at-index-2

   (kbd "3")          'wg-switch-to-workgroup-at-index-3

   (kbd "4")          'wg-switch-to-workgroup-at-index-4

   (kbd "5")          'wg-switch-to-workgroup-at-index-5

   (kbd "6")          'wg-switch-to-workgroup-at-index-6

   (kbd "7")          'wg-switch-to-workgroup-at-index-7

   (kbd "8")          'wg-switch-to-workgroup-at-index-8

   (kbd "9")          'wg-switch-to-workgroup-at-index-9

   (kbd "C-p")        'wg-switch-to-workgroup-left

   (kbd "p")          'wg-switch-to-workgroup-left

   (kbd "C-n")        'wg-switch-to-workgroup-right

   (kbd "n")          'wg-switch-to-workgroup-right

   (kbd "C-a")        'wg-switch-to-previous-workgroup

   (kbd "a")          'wg-switch-to-previous-workgroup

   ;; updating and reverting

   ;; wconfig undo/redo

   (kbd "C-r")        'wg-revert-workgroup

   (kbd "r")          'wg-revert-workgroup

   (kbd "C-S-r")      'wg-revert-all-workgroups

   (kbd "R")          'wg-revert-all-workgroups

   (kbd "<left>")     'wg-undo-wconfig-change

   (kbd "<right>")    'wg-redo-wconfig-change

   (kbd "[")          'wg-undo-wconfig-change

   (kbd "]")          'wg-redo-wconfig-change

   (kbd "{")          'wg-undo-once-all-workgroups

   (kbd "}")          'wg-redo-once-all-workgroups

   ;; wconfig save/restore

   (kbd "C-d C-s")    'wg-save-wconfig

   (kbd "C-d C-'")    'wg-restore-saved-wconfig

   (kbd "C-d C-k")    'wg-kill-saved-wconfig

   ;; workgroup movement

   (kbd "C-x")        'wg-swap-workgroups

   (kbd "C-,")        'wg-offset-workgroup-left

   (kbd "C-.")        'wg-offset-workgroup-right

   ;; window moving and frame reversal

   (kbd "|")          'wg-reverse-frame-horizontally

   (kbd "\\")         'wg-reverse-frame-vertically

   (kbd "/")          'wg-reverse-frame-horizontally-and-vertically

   ;; toggling

   (kbd "C-t C-m")    'wg-toggle-mode-line-display

   (kbd "C-t C-d")    'wg-toggle-window-dedicated-p

   ;; misc

   (kbd "!")          'wg-reset

   (kbd "?")          'wg-help

  "The keymap that sits on `wg-prefix-key'.")

(defun wg-make-workgroups-mode-map ()

  "Return Workgroups' minor-mode-map.

This map includes `wg-prefixed-map' on `wg-prefix-key', as well

as Workgroups' command remappings."

  (let ((map (make-sparse-keymap)))

    (define-key map wg-prefix-key

      wg-prefixed-map)

    (when (and (fboundp 'winner-undo)

               (fboundp 'winner-redo))

      (define-key map [remap winner-undo] 'wg-undo-wconfig-change)

      (define-key map [remap winner-redo] 'wg-redo-wconfig-change))

    (setq workgroups-mode-map map)))

(defun wg-min-size (dir)

  "Return the minimum window size in split direction DIR."

  (if dir wg-window-min-height wg-window-min-width))

(defun wg-actual-min-size (dir)

  "Return the actual minimum window size in split direction DIR."

  (if dir wg-actual-min-height wg-actual-min-width))

(defmacro wg-with-edges (w spec &rest body)

  "Bind W's edge list to SPEC and eval BODY."

  (declare (indent 2))

  `(wg-dbind ,spec (wg-w-edges ,w) ,@body))

(defmacro wg-with-bounds (wtree dir spec &rest body)

  "Bind SPEC to W's bounds in DIR, and eval BODY.

\"bounds\" are a direction-independent way of dealing with edge lists."

  (declare (indent 3))

  (wg-with-gensyms (dir-sym l1 t1 r1 b1)

    (wg-dbind (ls1 hs1 lb1 hb1) spec

      `(wg-with-edges ,wtree (,l1 ,t1 ,r1 ,b1)

         (cond (,dir (let ((,ls1 ,l1) (,hs1 ,r1) (,lb1 ,t1) (,hb1 ,b1))

                       ,@body))

               (t    (let ((,ls1 ,t1) (,hs1 ,b1) (,lb1 ,l1) (,hb1 ,r1))

                       ,@body)))))))

(defun wg-set-bounds (w dir ls hs lb hb)

  "Set W's edges in DIR with bounds LS HS LB and HB."

  (wg-set-edges w (if dir (list ls lb hs hb) (list lb ls hb hs))))

(defun wg-step-edges (edges1 edges2 hstep vstep)

  "Return W1's edges stepped once toward W2's by HSTEP and VSTEP."

  (wg-dbind (l1 t1 r1 b1) edges1

    (wg-dbind (l2 t2 r2 b2) edges2

      (let ((left (wg-step-to l1 l2 hstep))

            (top  (wg-step-to t1 t2 vstep)))

        (list left top

              (+ left (wg-step-to (- r1 l1) (- r2 l2) hstep))

              (+ top  (wg-step-to (- b1 t1) (- b2 t2) vstep)))))))

(defun wg-w-edge-operation (w edges op)

  "Return a copy of W with its edges mapped against EDGES through OP."

  (wg-set-edges w (cl-mapcar op (wg-w-edges w) edges)))

(defun wg-first-win (w)

  "Return the first actual window in W."

  (if (wg-win-p w) w

    (wg-first-win (car (wg-wtree-wlist w)))))

(defun wg-last-win (w)

  "Return the last actual window in W."

  (if (wg-win-p w) w

    (wg-last-win (-last-item (wg-wtree-wlist w)))))

(defun wg-minify-win (w)

  "Set W's edges to the smallest allowable."

  (let* ((edges (wg-w-edges w))

         (left (car edges))

         (top (cadr edges)))

    (wg-set-edges w (list left top

                          (+ left wg-actual-min-width)

                          (+ top  wg-actual-min-height)))))

(defun wg-minified-copy-of-last-win (w)

  "Minify a copy of the last actual window in W."

  (wg-minify-win (wg-copy-win (wg-last-win w))))

(defun wg-w-size (w &optional height)

  "Return the width or height of W, calculated from its edge list."

  (wg-with-edges w (l1 t1 r1 b1)

    (if height (- b1 t1) (- r1 l1))))

(defun wg-adjust-w-size (w width-fn height-fn &optional new-left new-top)

  "Adjust W's width and height with WIDTH-FN and HEIGHT-FN."

  (wg-with-edges w (left top right bottom)

    (let ((left (or new-left left)) (top (or new-top top)))

      (wg-set-edges (wg-copy-w w)

                    (list left

top

                          (+ left (funcall width-fn  (- right  left)))

                          (+ top  (funcall height-fn (- bottom top))))))))

(defun wg-scale-w-size (w width-scale height-scale)

  "Scale W's size by WIDTH-SCALE and HEIGHT-SCALE."

  (cl-labels

      ((wscale (width)  (truncate (* width  width-scale)))

       (hscale (height) (truncate (* height height-scale))))

    (wg-adjust-w-size w #'wscale #'hscale)))

(defun wg-restore-window (win)

  "Restore WIN in `selected-window'."

  (let ((selwin (selected-window))

        (buf (wg-find-buf-by-uid (wg-win-buf-uid win))))

    (if (not buf)

        (wg-restore-default-buffer)

      (when (wg-restore-buffer buf t)

        ;; Restore various positions in WINDOW from their values in WIN

        ;; (wg-restore-window-positions win selwin)

        (let ((window (or selwin (selected-window))))

          (wg-with-slots win

              ((win-point wg-win-point)

               (win-start wg-win-start)

               (win-hscroll wg-win-hscroll))

            (set-window-start window win-start t)

            (set-window-hscroll window win-hscroll)

            (set-window-point

             window

             (cond ((not wg-restore-point) win-start)

                   ((eq win-point :max) (point-max))

                   (t win-point)))

            (when (>= win-start (point-max)) (recenter))))

        (when wg-restore-window-dedicated-p

          (set-window-dedicated-p selwin (wg-win-dedicated win)))))

    (ignore-errors

      (set-window-prev-buffers

       selwin (wg-unpickel (wg-win-parameter win 'prev-buffers)))

      (set-window-next-buffers

       selwin (wg-unpickel (wg-win-parameter win 'next-buffers)))

)))

(defun wg-window-point (ewin)

  "Return `point' or :max.  See `wg-restore-point-max'.

EWIN should be an Emacs window object."

  (let ((p (window-point ewin)))

    (if (and wg-restore-point-max (= p (point-max))) :max p)))

(defun wg-win-parameter (win parameter &optional default)

  "Return WIN's value for PARAMETER.

If PARAMETER is not found, return DEFAULT which defaults to nil.

SESSION nil defaults to the current session."

  (wg-aget (wg-win-parameters win) parameter default))

(defun wg-set-win-parameter (win parameter value)

  "Set WIN's value of PARAMETER to VALUE.

SESSION nil means use the current session.

Return value."

  (wg-set-parameter (wg-win-parameters win) parameter value)

  value)

;; (wg-win-parameters (wg-window-to-win (selected-window)))

(defun wg-remove-win-parameter (win parameter)

  "Remove parameter PARAMETER from WIN's parameters."

  (wg-asetf (wg-win-parameters win) (wg-aremove it parameter)))

(defun wg-window-to-win (window)

  "Return the serialization (a wg-win) of Emacs window WINDOW."

  (let ((selected (eq window (selected-window)))

        win)

    (with-selected-window window

      (setq win

            (wg-make-win

             :edges              (window-edges window)

             :point              (wg-window-point window)

             :start              (window-start window)

             :hscroll            (window-hscroll window)

             :selected           selected

             :minibuffer-scroll  (eq window minibuffer-scroll-window)

             :dedicated          (window-dedicated-p window)

             :buf-uid            (wg-buffer-uid-or-add (window-buffer window))))

      (unless (version< emacs-version "24")

        (wg-set-win-parameter

         win 'next-buffers (wg-pickel (remove nil (cl-subseq (window-next-buffers window) 0 4))))

        (wg-set-win-parameter

         win 'prev-buffers (wg-pickel (remove nil (cl-subseq (window-prev-buffers window) 0 4))))))

    win))

(defun wg-toggle-window-dedicated-p ()

  "Toggle `window-dedicated-p' in `selected-window'."

  (interactive)

  (set-window-dedicated-p nil (not (window-dedicated-p)))

  (force-mode-line-update t)

  (wg-fontified-message

    (:cmd "Window:")

    (:cur (concat (unless (window-dedicated-p) " not") " dedicated"))))

(defun wg-w-edges (w)

  "Return W's edge list."

  (cl-etypecase w

    (wg-win (wg-win-edges w))

    (wg-wtree (wg-wtree-edges w))))

(defun wg-copy-w (w)

  "Return a copy of W.  W should be a wg-win or a wg-wtree."

  (cl-etypecase w

    (wg-win (wg-copy-win w))

    (wg-wtree (wg-copy-wtree w))))

(defun wg-set-edges (w edges)

  "Set W's EDGES list, and return W."

  (cl-etypecase w

    (wg-win (setf (wg-win-edges w) edges))

    (wg-wtree (setf (wg-wtree-edges w) edges)))

w)

(defun wg-equal-wtrees (w1 w2)

  "Return t when W1 and W2 have equal structure."

  (cond ((and (wg-win-p w1) (wg-win-p w2))

         (equal (wg-w-edges w1) (wg-w-edges w2)))

        ((and (wg-wtree-p w1) (wg-wtree-p w2))

         (and (eq (wg-wtree-dir w1) (wg-wtree-dir w2))

              (equal (wg-wtree-edges w1) (wg-wtree-edges w2))

              (cl-every #'wg-equal-wtrees

                        (wg-wtree-wlist w1)

                        (wg-wtree-wlist w2))))))

(defun wg-normalize-wtree (wtree)

  "Clean up and return a new wtree from WTREE.

Recalculate the edge lists of all subwins, and remove subwins

outside of WTREE's bounds.  If there's only one element in the

new wlist, return it instead of a new wtree."

  (if (wg-win-p wtree) wtree

    (wg-with-slots wtree ((dir wg-wtree-dir)

                          (wlist wg-wtree-wlist))

      (wg-with-bounds wtree dir (ls1 hs1 lb1 hb1)

        (let* ((min-size (wg-min-size dir))

               (max (- hb1 1 min-size))

               (lastw (-last-item wlist)))

          (cl-labels

              ((mapwl

                (wl)

                (wg-dbind (sw . rest) wl

                  (cons (wg-normalize-wtree

                         (wg-set-bounds

                          sw dir ls1 hs1 lb1

                          (setq lb1 (if (eq sw lastw) hb1

                                      (let ((hb2 (+ lb1 (wg-w-size sw dir))))

                                        (if (>= hb2 max) hb1 hb2))))))

                        (when (< lb1 max) (mapwl rest))))))

            (let ((new (mapwl wlist)))

              (if (not (cdr new)) (car new)

                (setf (wg-wtree-wlist wtree) new)

                wtree))))))))

(defun wg-scale-wtree (wtree wscale hscale)

  "Return a copy of WTREE with its dimensions scaled by WSCALE and HSCALE.

All WTREE's subwins are scaled as well."

  (let ((scaled (wg-scale-w-size wtree wscale hscale)))

    (if (wg-win-p wtree) scaled

      (wg-asetf (wg-wtree-wlist scaled)

                (wg-docar (sw it) (wg-scale-wtree sw wscale hscale)))

      scaled)))

(defun wg-resize-frame-scale-wtree (wconfig)

  "Set FRAME's size to WCONFIG's, returning a possibly scaled wtree.

If the frame size was set correctly, return WCONFIG's wtree

unchanged.  If it wasn't, return a copy of WCONFIG's wtree scaled

with `wg-scale-wconfigs-wtree' to fit the frame as it exists."

  (let ((frame (selected-frame)))

    (wg-with-slots wconfig ((wcwidth wg-wconfig-width)

                            (wcheight wg-wconfig-height))

      (when window-system (set-frame-size frame wcwidth wcheight))

      (let ((fwidth  (frame-parameter frame 'width))

            (fheight (frame-parameter frame 'height)))

        (if (and (= wcwidth fwidth) (= wcheight fheight))

            (wg-wconfig-wtree wconfig)

          (wg-scale-wconfigs-wtree wconfig fwidth fheight))))))

(defun wg-wtree-buf-uids (wtree)

  "Return a new list of the buf uids of all wins in WTREE."

  (if (not wtree)

      (error "WTREE is nil in `wg-wtree-buf-uids'!"))

  (wg-flatten-wtree wtree 'wg-win-buf-uid))

(defun wg-wtree-unique-buf-uids (wtree)

  "Return a list of the unique buf uids of all wins in WTREE."

  (cl-remove-duplicates (wg-wtree-buf-uids wtree) :test 'string=))

(defun wg-reset-window-tree ()

  "Delete all but one window in `selected-frame', and reset

various parameters of that window in preparation for restoring

a wtree."

  (delete-other-windows)

  (set-window-dedicated-p nil nil))

(defun wg-restore-window-tree-helper (w)

  "Recursion helper for `wg-restore-window-tree'."

  "Recursion helper for `wg-restore-window-tree' W."

  (if (wg-wtree-p w)

      (cl-loop with dir = (wg-wtree-dir w)

               for (win . rest) on (wg-wtree-wlist w)

               do (when rest (split-window nil (wg-w-size win dir) (not dir)))

               do (wg-restore-window-tree-helper win))

    (wg-restore-window w)

    (when (wg-win-selected w)

      (setq wg-window-tree-selected-window (selected-window)))

    (when (wg-win-minibuffer-scroll w)

      (setq minibuffer-scroll-window (selected-window)))

    (other-window 1)))

(defun wg-restore-window-tree (wtree)

  "Restore WTREE in `selected-frame'."

  (let ((window-min-width wg-window-min-width)

        (window-min-height wg-window-min-height)

        (wg-window-tree-selected-window nil))

    (wg-reset-window-tree)

    (wg-restore-window-tree-helper wtree)

    (awhen wg-window-tree-selected-window (select-window it))))

;; (wg-window-tree-to-wtree (window-tree))

(defun wg-window-tree-to-wtree (window-tree)

  "Return the serialization (a wg-wtree) of Emacs window tree WINDOW-TREE."

  (wg-barf-on-active-minibuffer)

  (cl-labels

      ((inner (w) (if (windowp w) (wg-window-to-win w)

                    (wg-dbind (dir edges . wins) w

                      (wg-make-wtree

                       :dir    dir

                       :edges  edges

                       :wlist  (mapcar #'inner wins))))))

    (let ((w (car window-tree)))

      (when (and (windowp w) (window-minibuffer-p w))

        (error "Workgroups can't operate on minibuffer-only frames."))

      (inner w))))

(defun wg-flatten-wtree (wtree &optional key)

  "Return a new list by flattening WTREE.

KEY non returns returns a list of WTREE's wins.

KEY non-nil returns a list of the results of calling KEY on each win."

  (cl-labels

      ((inner (w) (if (wg-win-p w) (list (if key (funcall key w) w))

                    (cl-mapcan #'inner (wg-wtree-wlist w)))))

    (inner wtree)))

(defun wg-reverse-wlist (w &optional dir)

  "Reverse W's wlist and those of all its sub-wtrees in direction DIR.

If DIR is nil, reverse WTREE horizontally.

If DIR is 'both, reverse WTREE both horizontally and vertically.

Otherwise, reverse WTREE vertically."

  (cl-labels

      ((inner (w) (if (wg-win-p w) w

                    (wg-with-slots w ((d1 wg-wtree-dir))

                      (wg-make-wtree

                       :dir d1

                       :edges (wg-wtree-edges w)

                       :wlist (let ((wl2 (mapcar #'inner (wg-wtree-wlist w))))

                                (if (or (eq dir 'both) (eq dir d1))

                                    (nreverse wl2)

                                  wl2)))))))

    (wg-normalize-wtree (inner w))))

(defun wg-wtree-move-window (wtree offset)

  "Offset `selected-window' OFFSET places in WTREE."

  (cl-labels

      ((inner (w) (if (wg-win-p w) w

                    (wg-with-slots w ((wlist wg-wtree-wlist))

                      (wg-make-wtree

                       :dir (wg-wtree-dir w)

                       :edges (wg-wtree-edges w)

                       :wlist (aif (cl-find t wlist :key 'wg-win-selected)

                                  (wg-cyclic-offset-elt it wlist offset)

                                (mapcar #'inner wlist)))))))

    (wg-normalize-wtree (inner wtree))))

(defun wg-frame-to-wconfig (&optional frame)

  "Return the serialization (a wg-wconfig) of Emacs frame FRAME.

FRAME nil defaults to `selected-frame'."

  (let* ((frame (or frame (selected-frame)))

         (fullscrn (frame-parameter frame 'fullscreen)))

    (wg-make-wconfig

     :left                  (frame-parameter frame 'left)

     :top                   (frame-parameter frame 'top)

     :width                 (frame-parameter frame 'width)

     :height                (frame-parameter frame 'height)

     :parameters            `((fullscreen . ,fullscrn))

     :vertical-scroll-bars  (frame-parameter frame 'vertical-scroll-bars)

     :scroll-bar-width      (frame-parameter frame 'scroll-bar-width)

     :wtree                 (wg-window-tree-to-wtree (window-tree frame))

)))

(defun wg-current-wconfig ()

  "Return the current wconfig.

If `wg-current-wconfig' is non-nil, return it.  Otherwise return

`wg-frame-to-wconfig'."

  (or (frame-parameter nil 'wg-current-wconfig)

      (wg-frame-to-wconfig)))

(defmacro wg-with-current-wconfig (frame wconfig &rest body)

  "Eval BODY with WCONFIG current in FRAME.

FRAME nil defaults to `selected-frame'."

  (declare (indent 2))

  (wg-with-gensyms (frame-sym old-value)

    `(let* ((,frame-sym (or ,frame (selected-frame)))

            (,old-value (frame-parameter ,frame-sym 'wg-current-wconfig)))

       (unwind-protect

           (progn

             (set-frame-parameter ,frame-sym 'wg-current-wconfig ,wconfig)

             ,@body)

         (when (frame-live-p ,frame-sym)

           (set-frame-parameter ,frame-sym 'wg-current-wconfig ,old-value))))))

(defun wg-make-blank-wconfig (&optional buffer)

  "Return a new blank wconfig.

BUFFER or `wg-default-buffer' is visible in the only window."

  (save-window-excursion

    (delete-other-windows)

    (switch-to-buffer (or buffer wg-default-buffer))

    (wg-frame-to-wconfig)))

(defun wg-wconfig-move-window (wconfig offset)

  "Offset `selected-window' OFFSET places in WCONFIG."

  (wg-asetf (wg-wconfig-wtree wconfig) (wg-wtree-move-window it offset))

  wconfig)

;;; base wconfig updating

(defun wg-update-working-wconfig-on-delete-frame (frame)

  "Update FRAME's current workgroup's working-wconfig before

FRAME is deleted, so we don't lose its state."

  (with-selected-frame frame

    (wg-update-current-workgroup-working-wconfig)))

(defun wg-wconfig-buf-uids (wconfig)

  "Return WCONFIG's wtree's `wg-wtree-buf-uids'."

  (if (not (wg-wconfig-wtree wconfig))

      (error "WTREE is nil in `wg-wconfig-buf-uids'!"))

  (wg-wtree-unique-buf-uids (wg-wconfig-wtree wconfig)))

(defun wg-wconfig-restore-frame-position (wconfig &optional frame)

  "Use WCONFIG to restore FRAME's position.

If frame is nil then `selected-frame'."

  (-when-let* ((left (wg-wconfig-left wconfig))

               (top (wg-wconfig-top wconfig)))

    ;; Check that arguments are integers

    ;; Problem: https://github.com/pashinin/workgroups2/issues/15

    (if (and (integerp left)

             (integerp top))

        (set-frame-position frame left top))))

(defun wg-wconfig-restore-scroll-bars (wconfig)

  "Restore `selected-frame's scroll-bar settings from WCONFIG."

  (set-frame-parameter

   nil 'vertical-scroll-bars (wg-wconfig-vertical-scroll-bars wconfig))

  (set-frame-parameter

   nil 'scroll-bar-width (wg-wconfig-scroll-bar-width wconfig)))

;;(defun wg-wconfig-restore-fullscreen (wconfig)

;;  "Restore `selected-frame's fullscreen settings from WCONFIG."

;;  (set-frame-parameter

;;   nil 'fullscreen (wg-wconfig-parameters wconfig))

;;  )

(defun wg-scale-wconfigs-wtree (wconfig new-width new-height)

  "Scale WCONFIG's wtree with NEW-WIDTH and NEW-HEIGHT.

Return a copy WCONFIG's wtree scaled with `wg-scale-wtree' by the

ratio or NEW-WIDTH to WCONFIG's width, and NEW-HEIGHT to

WCONFIG's height."

  (wg-normalize-wtree

   (wg-scale-wtree

    (wg-wconfig-wtree wconfig)

    (/ (float new-width)  (wg-wconfig-width wconfig))

    (/ (float new-height) (wg-wconfig-height wconfig)))))

(defun wg-scale-wconfig-to-frame (wconfig)

  "Scale WCONFIG buffers to fit current frame size.

Return a scaled copy of WCONFIG."

  (interactive)

  (wg-scale-wconfigs-wtree wconfig

                           (frame-parameter nil 'width)

                           (frame-parameter nil 'height)))

(defun wg-frame-resize-and-position (wconfig &optional frame)

  "Apply WCONFIG's size and position to a FRAME."

  (interactive)

  (unless frame (setq frame (selected-frame)))

  (let* ((params (wg-wconfig-parameters wconfig))

         fullscreen)

    (set-frame-parameter frame 'fullscreen (if (assoc 'fullscreen params)

                                               (cdr (assoc 'fullscreen params))

                                             nil))

    (when (and wg-restore-frame-position

               (not (frame-parameter frame 'fullscreen)))

      (wg-wconfig-restore-frame-position wconfig frame))

))

(defun wg-restore-frame-size-position (wconfig &optional fs)

  "Smart-restore of frame size and position.

Depending on `wg-remember-frame-for-each-wg' frame parameters may

be restored for each workgroup.

If `wg-remember-frame-for-each-wg' is nil (by default) then

current frame parameters are saved/restored to/from first

workgroup. And frame parameters for all other workgroups are just

ignored.

  (interactive)

  (let* ((params (wg-wconfig-parameters wconfig))

         fullscreen)

    ;; Frame maximized / fullscreen / none

    (unless wg-remember-frame-for-each-wg

      (setq params (wg-wconfig-parameters (wg-workgroup-working-wconfig (wg-first-workgroup)))))

    (setq fullscreen (if (assoc 'fullscreen params)

                         (cdr (assoc 'fullscreen params))

                       nil))

    (when (and fs

               fullscreen

               (or wg-remember-frame-for-each-wg

                   (null (wg-current-workgroup t))))

      (set-frame-parameter nil 'fullscreen fullscreen)

      ;; I had bugs restoring maximized frame:

      ;; Frame could be maximized but buffers are not scaled to fit it.

;;

      ;; Maybe because of `set-frame-parameter' takes some time to finish and is async.

      ;; So I tried this and it helped

      (sleep-for 0 100))

    ;; Position

    (when (and wg-restore-frame-position

               wg-remember-frame-for-each-wg

               (not (frame-parameter nil 'fullscreen)))

      (wg-wconfig-restore-frame-position wconfig))

))

(defun wg-restore-frames ()

  "Try to recreate opened frames, take info from session's 'frame-list parameter."

  (interactive)

  (delete-other-frames)

  (awhen (wg-current-session t)

    (let ((fl (wg-session-parameter 'frame-list nil it))

          (frame (selected-frame)))

      (mapc (lambda (wconfig)

              (with-selected-frame (make-frame)

                ;;(wg-frame-resize-and-position wconfig)

                ;;(wg-restore-frame-size-position wconfig)

                ;;(wg-wconfig-restore-frame-position wconfig)

                (wg-restore-wconfig wconfig)

                )) fl)

      (select-frame-set-input-focus frame))))

;; FIXME: throw a specific error if the restoration was unsuccessful

(defun wg-restore-wconfig (wconfig &optional frame)

  "Restore a workgroup configuration WCONFIG in a FRAME.

Runs each time you're switching workgroups."

  (unless frame (setq frame (selected-frame)))

  (let ((wg-record-incorrectly-restored-bufs t)

        (wg-incorrectly-restored-bufs nil)

        (params (wg-wconfig-parameters wconfig))

        fullscreen)

    (wg-barf-on-active-minibuffer)

    (when wg-restore-scroll-bars

      (wg-wconfig-restore-scroll-bars wconfig))

    (when (null (wg-current-workgroup t))

      (set-frame-parameter frame 'fullscreen (if (assoc 'fullscreen params)

                                                 (cdr (assoc 'fullscreen params))

                                               nil)))

    ;; Restore frame position

    (when (and wg-restore-frame-position

               (not (frame-parameter nil 'fullscreen))

               (null (wg-current-workgroup t)))

      (wg-wconfig-restore-frame-position wconfig frame))

    ;; Restore buffers

    (wg-restore-window-tree (wg-scale-wconfig-to-frame wconfig))

    (when wg-incorrectly-restored-bufs

      (message "Unable to restore these buffers: %S\

If you want, restore them manually and try again."

               (mapcar 'wg-buf-name wg-incorrectly-restored-bufs)))))

;;; saved wconfig commands

(defun wg-save-wconfig ()

  "Save the current wconfig to the current workgroup's saved wconfigs."

  (interactive)

  (let* ((workgroup (wg-current-workgroup))

         (name (wg-read-saved-wconfig-name workgroup))

         (wconfig (wg-current-wconfig)))

    (setf (wg-wconfig-name wconfig) name)

    (wg-workgroup-save-wconfig workgroup wconfig)

    (wg-fontified-message

      (:cmd "Saved: ")

      (:cur name))))

(defun wg-restore-saved-wconfig ()

  "Restore one of the current workgroup's saved wconfigs in `selected-frame'."

  (interactive)

  (let ((workgroup (wg-current-workgroup)))

    (wg-restore-wconfig-undoably

     (wg-workgroup-get-saved-wconfig

      workgroup

      (ido-completing-read "Saved wconfig: "

                           (mapcar 'wg-wconfig-name (wg-workgroup-saved-wconfigs workgroup))

                           nil t)))))

(defun wg-kill-saved-wconfig ()

  "Kill one of the current workgroup's saved wconfigs.

Also add it to the wconfig kill-ring."

  (interactive)

  (let* ((workgroup (wg-current-workgroup))

         (wconfig (wg-read-saved-wconfig workgroup)))

    (wg-workgroup-kill-saved-wconfig workgroup wconfig)

    (wg-add-to-wconfig-kill-ring wconfig)

    (wg-fontified-message

      (:cmd "Deleted: ")

      (:cur (wg-wconfig-name wconfig)))))

(defun wg-reverse-wconfig (wconfig &optional dir)

  "Reverse WCONFIG's wtree's wlist in direction DIR."

  (wg-asetf (wg-wconfig-wtree wconfig) (wg-reverse-wlist it dir))

  wconfig)

;; specialbufs

(defcustom wg-special-buffer-serdes-functions

  '(wg-serialize-comint-buffer

    wg-serialize-speedbar-buffer)

  "Functions providing serialization/deserialization for complex buffers.

Use `wg-support' macro and this variable will be filled

automatically.

An entry should be either a function symbol or a lambda, and should

accept a single Emacs buffer object as an argument.

When a buffer is to be serialized, it is passed to each of these

functions in turn until one returns non-nil, or the list ends.  A

return value of nil indicates that the function can't handle

buffers of that type.  A non-nil return value indicates that it

can.  The first non-nil return value becomes the buffer's special

serialization data.  The return value should be a cons, with a

deserialization function (a function symbol or a lambda) as the car,

and any other serialization data as the cdr.

When it comes time to deserialize the buffer, the deserialization

function (the car of the cons mentioned above) is passed the

wg-buf object, from which it should restore the buffer.  The

special serialization data itself can be accessed

with (cdr (wg-buf-special-data <wg-buf>)).  The deserialization

function must return the restored Emacs buffer object.

See the definitions of the functions in this list for examples of

how to write your own."

  :type 'alist

  :group 'workgroups)

;; Dired

(wg-support 'dired-mode 'dired

            `((deserialize . ,(lambda (buffer vars)

                                (when (or wg-restore-remote-buffers

                                          (not (file-remote-p default-directory)))

                                  (let ((d (wg-get-first-existing-dir)))

                                    (if (file-directory-p d) (dired d))))))))

;; `Info-mode'     C-h i

(wg-support 'Info-mode 'info

            `((save . (Info-current-file Info-current-node))

              (deserialize . ,(lambda (buffer vars)

                                ;;(with-current-buffer

                                ;;    (get-buffer-create (wg-buf-name buffer))

                                (aif vars

                                    (if (fboundp 'Info-find-node)

                                        (apply #'Info-find-node it))

                                  (info)

                                  (get-buffer (wg-buf-name buffer)))))))

;; `help-mode'

;; Bug: https://github.com/pashinin/workgroups2/issues/29

(if nil

    (wg-support 'help-mode 'help-mode

                `((save . (help-xref-stack-item help-xref-stack help-xref-forward-stack))

                  (deserialize . ,(lambda (buffer vars)

                                    (wg-dbind (item stack forward-stack) vars

                                      (condition-case err

                                          (apply (car item) (cdr item))

                                        (error (message "%s" err)))

                                      (awhen (get-buffer "*Help*")

                                        (set-buffer it)

                                        (wg-when-boundp (help-xref-stack help-xref-forward-stack)

                                          (setq help-xref-stack stack

                                                help-xref-forward-stack forward-stack))))))))

@@ -2927,779 +2925,779 @@ You can get these commands using `wg-get-org-agenda-view-commands'."

;;      (list 'wg-deserialize-mime-view-buffer

;;            ))))

;; emms-playlist-mode

;;

;; Help me on this one:

;; 1. How to start emms without any user interaction?

;;

;;(defun wg-deserialize-emms-buffer (buf)

;;  "Deserialize emms-playlist buffer BUF."

;;  (when (require 'emms-setup nil 'noerror)

;;    (require 'emms-player-mplayer)

;;    (emms-standard)

;;    (emms-default-players)

;;    (if (fboundp 'emms-playlist-mode)

;;        (wg-dbind (this-function args) (wg-buf-special-data buf)

;;          (let ((default-directory (car args)))

;;            (save-window-excursion

;;              ;;(emms)

;;              (if (or (null emms-playlist-buffer)

;;                      (not (buffer-live-p emms-playlist-buffer)))

;;                  ;;(call-interactively 'emms-add-file)

;;                  (emms-source-directory "/usr/data/disk_3/Music/SORT/")

;;                ))

;;            ;; (emms)

;;            ;;(with-current-buffer emms-playlist-buffer-name

;;            ;;(emms-source-playlist-directory-tree "/usr/data/disk_3/Music/SORT/")

;;            ;;(emms-source-directory "/usr/data/disk_3/Music/SORT")

;;            ;;(switch-to-buffer emms-playlist-buffer-name)

;;            (emms-playlist-mode-go)

;;            (current-buffer)

;;            )))))

;;

;;(defun wg-serialize-emms-buffer (buffer)

;;  "Serialize emms BUFFER."

;;  (with-current-buffer buffer

;;    (if (fboundp 'emms-playlist-mode)

;;        (when (eq major-mode 'emms-playlist-mode)

;;          (list 'wg-deserialize-emms-buffer

;;                (wg-take-until-unreadable (list default-directory))

;;                )))))

;;; buffer-local variable serdes

(defun wg-serialize-buffer-mark-ring ()

  "Return a new list of the positions of the marks in `mark-ring'."

  (mapcar 'marker-position mark-ring))

(defun wg-deserialize-buffer-mark-ring (positions)

  "Set `mark-ring' to a new list of markers created from POSITIONS."

  (setq mark-ring

        (mapcar (lambda (pos) (set-marker (make-marker) pos))

                positions)))

(defun wg-deserialize-buffer-major-mode (major-mode-symbol)

  "Conditionally retore MAJOR-MODE-SYMBOL in `current-buffer'."

  (and (fboundp major-mode-symbol)

       (not (eq major-mode-symbol major-mode))

       (funcall major-mode-symbol)))

(defun wg-deserialize-buffer-local-variables (buf)

  "Restore BUF's buffer local variables in `current-buffer'."

  (cl-loop for ((var . val) . rest) on (wg-buf-local-vars buf)

           do (awhen (assq var wg-buffer-local-variables-alist)

                (wg-dbind (var ser des) it

                  (if des (funcall des val)

                    (set var val))))))

(defmacro wg-workgroup-list ()

  "Setf'able `wg-current-session' modified slot accessor."

  `(wg-session-workgroup-list (wg-current-session)))

(defmacro wg-buf-list ()

  "Setf'able `wg-current-session' buf-list slot accessor."

  `(wg-session-buf-list (wg-current-session)))

(defun wg-restore-default-buffer (&optional switch)

  "Return `wg-default-buffer' and maybe SWITCH to it."

  (if switch

      (switch-to-buffer wg-default-buffer t)

    (get-buffer-create wg-default-buffer)))

(defun wg-restore-existing-buffer (buf &optional switch)

  "Return existing buffer from BUF and maybe SWITCH to it."

  (-when-let (b (wg-find-buf-in-buffer-list buf (wg-buffer-list-emacs)))

    (if switch (switch-to-buffer b t))

    (with-current-buffer b

      (wg-set-buffer-uid-or-error (wg-buf-uid buf))

      b)))

(defun wg-restore-file-buffer (buf &optional switch)

  "Restore BUF by finding its file and maybe SWITCH to it.

Return the created buffer.

If BUF's file doesn't exist, call `wg-restore-default-buffer'"

  ;;(-when-let ((file-name (wg-buf-file-name buf)))

  (let ((file-name (wg-buf-file-name buf)))

    (when (and file-name

               (or wg-restore-remote-buffers

                   (not (file-remote-p file-name))))

      (cond ((file-exists-p file-name)

             ;; jit ignore errors

             ;;(ignore-errors

             (condition-case err

                 (let ((b (find-file-noselect file-name nil nil nil)))

                   (with-current-buffer b

                     (rename-buffer (wg-buf-name buf) t)

                     (wg-set-buffer-uid-or-error (wg-buf-uid buf))

                     (when wg-restore-mark

                       (set-mark (wg-buf-mark buf))

                       (deactivate-mark))

                     (wg-deserialize-buffer-local-variables buf)

                   (if switch (switch-to-buffer b))

b)

               (error

                (message "Error while restoring a file %s:\n  %s" file-name (error-message-string err))

                nil)))

(t

             ;; try directory

             (if (file-directory-p (file-name-directory file-name))

                 (dired (file-name-directory file-name))

               (progn

                 (message "Attempt to restore nonexistent file: %S" file-name)

                 nil))

             )))))

(defun wg-restore-special-buffer (buf &optional switch)

  "Restore a buffer BUF with DESERIALIZER-FN and maybe SWITCH to it."

  (-when-let*

      ((special-data (wg-buf-special-data buf))

       (buffer (save-window-excursion

                 (condition-case err

                     (funcall (car special-data) buf)

                   (error (message "Error deserializing %S: %S" (wg-buf-name buf) err)

                          nil)))))

    (if switch (switch-to-buffer buffer t))

    (with-current-buffer buffer

      (wg-set-buffer-uid-or-error (wg-buf-uid buf)))

    buffer))

(defun wg-restore-buffer (buf &optional switch)

  "Restore BUF, return it and maybe SWITCH to it."

  (fset 'buffer-list wg-buffer-list-original)

  (prog1

      (or (wg-restore-existing-buffer buf switch)

          (wg-restore-special-buffer buf switch)  ;; non existent dired problem

          (wg-restore-file-buffer buf switch)

          (progn (wg-restore-default-buffer switch) nil))

    (if wg-mess-with-buffer-list

        (fset 'buffer-list wg-buffer-list-function))))

;;; buffer object utils

(defun wg-buffer-uid (buffer-or-name)

  "Return BUFFER-OR-NAME's buffer-local value of `wg-buffer-uid'."

  (buffer-local-value 'wg-buffer-uid (wg-get-buffer buffer-or-name)))

(defun wg-bufobj-uid (bufobj)

  "Return BUFOBJ's uid."

  (cl-etypecase bufobj

    (buffer (wg-buffer-uid bufobj))

    (wg-buf (wg-buf-uid bufobj))

    (string (wg-bufobj-uid (wg-get-buffer bufobj)))))

(defun wg-bufobj-name (bufobj)

  "Return BUFOBJ's buffer name."

  (cl-etypecase bufobj

    (buffer (buffer-name bufobj))

    (wg-buf (wg-buf-name bufobj))

    (string (wg-buffer-name bufobj))))

(defun wg-bufobj-file-name (bufobj)

  "Return BUFOBJ's filename."

  (cl-etypecase bufobj

    (buffer (buffer-file-name bufobj))

    (wg-buf (wg-buf-file-name bufobj))

    (string (wg-bufobj-file-name (wg-get-buffer bufobj)))))

(defun wg-buf-major-mode (buf)

  "Return BUF's `major-mode'.

It's stored in BUF's local-vars list, since it's a local variable."

  (wg-aget (wg-buf-local-vars buf) 'major-mode))

(defun wg-buffer-major-mode (bufobj)

  "Return BUFOBJ's `major-mode'.

It works with Emacs buffer, Workgroups buffer object and a simple string."

  (cl-etypecase bufobj

    (buffer (wg-buffer-major-mode bufobj))

    (wg-buf (wg-buf-major-mode bufobj))

    (string (wg-buffer-major-mode bufobj))))

;; `wg-equal-bufobjs' and `wg-find-bufobj' may need to be made a lot smarter

(defun wg-equal-bufobjs (bufobj1 bufobj2)

  "Return t if BUFOBJ1 is \"equal\" to BUFOBJ2."

  (let ((fname1 (wg-bufobj-file-name bufobj1))

        (fname2 (wg-bufobj-file-name bufobj2)))

    (cond ((and fname1 fname2) (string= fname1 fname2))

          ((or fname1 fname2) nil)

          ((string= (wg-bufobj-name bufobj1) (wg-bufobj-name bufobj2)) t))))

(defun wg-find-bufobj (bufobj bufobj-list)

  "Find BUFOBJ in BUFOBJ-LIST, testing with `wg-equal-bufobjs'."

  (cl-find bufobj bufobj-list :test 'wg-equal-bufobjs))

(defun wg-find-bufobj-by-uid (uid bufobj-list)

  "Find the bufobj in BUFOBJ-LIST with uid UID."

  (cl-find uid bufobj-list :test 'string= :key 'wg-bufobj-uid))

(defun wg-find-buf-in-buf-list (buf buf-list)

  "Find BUF in BUF-LIST.

This is only here for completeness."

  (cl-find buf buf-list))

(defun wg-find-buffer-in-buffer-list (buffer-or-name buffer-list)

  "Find BUFFER-OR-NAME in BUFFER-LIST."

  (cl-find (wg-get-buffer buffer-or-name) buffer-list :key 'wg-get-buffer))

(defun wg-find-buffer-in-buf-list (buffer-or-name buf-list)

  "Find BUFFER-OR-NAME in BUF-LIST."

  (aif (wg-buffer-uid buffer-or-name)

      (wg-find-bufobj-by-uid it buf-list)

    (wg-find-bufobj buffer-or-name buf-list)))

(defun wg-find-buf-in-buffer-list (buf buffer-list)

  "Find BUF in BUFFER-LIST."

  (or (wg-find-bufobj-by-uid (wg-buf-uid buf) buffer-list)

      (wg-find-bufobj buf buffer-list)))

(defun wg-find-buf-by-uid (uid)

  "Find a buf in `wg-buf-list' by UID."

  (wg-find-bufobj-by-uid uid (wg-buf-list)))

(defun wg-set-buffer-uid-or-error (uid &optional buffer)

  "Set BUFFER's buffer local value of `wg-buffer-uid' to UID.

If BUFFER already has a buffer local value of `wg-buffer-uid',

and it's not equal to UID, error."

  (if wg-buffer-uid

      ;;(if (string= wg-buffer-uid uid) uid

      ;;  (error "uids don't match %S and %S" uid wg-buffer-uid))

      (setq wg-buffer-uid uid)))

(defun wg-buffer-special-data (buffer)

  "Return BUFFER's auxiliary serialization, or nil."

  (cl-some (lambda (fn) (funcall fn buffer)) wg-special-buffer-serdes-functions))

(defun wg-serialize-buffer-local-variables ()

  "Return an alist of buffer-local variable symbols and their values.

See `wg-buffer-local-variables-alist' for details."

  (wg-docar (entry wg-buffer-local-variables-alist)

    (wg-dbind (var ser des) entry

      (when (local-variable-p var)

        (cons var (if ser (funcall ser) (symbol-value var)))))))

(defun wg-buffer-to-buf (buffer)

  "Return the serialization (a wg-buf) of Emacs buffer BUFFER."

  (with-current-buffer buffer

    (wg-make-buf

     :name           (buffer-name)

     :file-name      (buffer-file-name)

     :point          (point)

     :mark           (mark)

     :local-vars     (wg-serialize-buffer-local-variables)

     :special-data   (wg-buffer-special-data buffer))))

(defun wg-add-buffer-to-buf-list (buffer)

  "Make a buf from BUFFER, and add it to `wg-buf-list' if necessary.

If there isn't already a buf corresponding to BUFFER in

`wg-buf-list', make one and add it.  Return BUFFER's uid

in either case."

  (with-current-buffer buffer

    (setq wg-buffer-uid

          (aif (wg-find-buffer-in-buf-list buffer (wg-buf-list))

              (wg-buf-uid it)

            (let ((buf (wg-buffer-to-buf buffer)))

              (push buf (wg-buf-list))

              (wg-buf-uid buf))))))

(defun wg-buffer-uid-or-add (buffer)

  "Return BUFFER's uid.

If there isn't already a buf corresponding to BUFFER in

`wg-buf-list', make one and add it."

  (or (wg-buffer-uid buffer) (wg-add-buffer-to-buf-list buffer)))

(defun wg-bufobj-uid-or-add (bufobj)

  "If BUFOBJ is a wg-buf, return its uid.

If BUFOBJ is a buffer or a buffer name, see `wg-buffer-uid-or-add'."

  (cl-etypecase bufobj

    (wg-buf (wg-buf-uid bufobj)) ;; possibly also add to `wg-buf-list'

    (buffer (wg-buffer-uid-or-add bufobj))

    (string (wg-bufobj-uid-or-add (wg-get-buffer bufobj)))))

(defun wg-reset-buffer (buffer)

  "Return BUFFER.

Currently only sets BUFFER's `wg-buffer-uid' to nil."

  (with-current-buffer buffer (setq wg-buffer-uid nil)))

(defun wg-update-buffer-in-buf-list (&optional buffer)

  "Update BUFFER's corresponding buf in `wg-buf-list'.

BUFFER nil defaults to `current-buffer'."

  (let ((buffer (or buffer (current-buffer))))

    (-when-let* ((uid (wg-buffer-uid buffer))

                 (old-buf (wg-find-buf-by-uid uid))

                 (new-buf (wg-buffer-to-buf buffer)))

      (setf (wg-buf-uid new-buf) (wg-buf-uid old-buf))

      (wg-asetf (wg-buf-list) (cons new-buf (remove old-buf it))))))

(defvar wg-just-exited-minibuffer nil

  "Flag set by `minibuffer-exit-hook'.

To exempt from undoification those window-configuration changes

caused by exiting the minibuffer.  This is ugly, but necessary.

It may seem like we could just null out

`wg-undoify-window-configuration-change' in

`minibuffer-exit-hook', but that also prevents undoification of

window configuration changes triggered by commands called with

`execute-extended-command' -- i.e. it's just too coarse.")

(defcustom wg-no-confirm-on-destructive-operation nil

  "Do not request confirmation before various destructive operations."

  :type 'boolean

  :group 'workgroups)

(defcustom wg-minibuffer-message-timeout 0.75

  "Bound to `minibuffer-message-timeout' when messaging while the

minibuffer is active."

  :type 'float

  :group 'workgroups)

(defun wg-read-object (prompt test warning &optional initial-contents keymap

                              read hist default-value inherit-input-method)

  "PROMPT for an object that satisfies TEST.  WARNING if necessary.

INITIAL-CONTENTS KEYMAP READ HIST DEFAULT-VALUE

INHERIT-INPUT-METHOD are `read-from-minibuffer's args."

  (cl-labels ((read () (read-from-minibuffer

                        prompt initial-contents keymap read hist

                        default-value inherit-input-method)))

    (let ((obj (read)))

      (when (and (equal obj "") default-value) (setq obj default-value))

      (while (not (funcall test obj))

        (message warning)

        (sit-for wg-minibuffer-message-timeout)

        (setq obj (read)))

      obj)))

(defun wg-read-new-workgroup-name (&optional prompt)

  "Read a non-empty name string from the minibuffer.

Print PROMPT"

  (let ((default (wg-new-default-workgroup-name)))

    (wg-read-object

     (or prompt (format "Name (default: %S): " default))

     (lambda (new) (and (stringp new)

                        (not (equal new ""))

                        (wg-unique-workgroup-name-p new)))

     "Please enter a unique, non-empty name"

     nil nil nil nil default)))

(defun wg-read-workgroup-index ()

  "Prompt for the index of a workgroup."

  (let ((max (1- (length (wg-workgroup-list-or-error)))))

    (wg-read-object

     (format "%s\n\nEnter [0-%d]: " (wg-workgroup-list-display) max)

     (lambda (obj) (and (integerp obj) (wg-within obj 0 max t)))

     (format "Please enter an integer [%d-%d]" 0 max)

     nil nil t)))

(defun wg-minibuffer-inactive-p ()

  "Return t when `minibuffer-depth' is zero, nil otherwise."

  (zerop (minibuffer-depth)))

(defun wg-barf-on-active-minibuffer ()

  "Throw an error when the minibuffer is active."

  (when (not (wg-minibuffer-inactive-p))

    (error "Exit minibuffer to use workgroups functions!")))

(defvar wg-deactivation-list nil

  "A stack of workgroups that are currently being switched away from.

Used to avoid associating the old workgroup's buffers with the

new workgroup during a switch.")

(defun wg-flag-workgroup-modified (workgroup)

  "Set WORKGROUP's and the current session's modified flags."

  (when wg-flag-modified

    (setf (wg-workgroup-modified workgroup) t)

    (setf (wg-session-modified (wg-current-session)) t)))

(defun wg-flag-session-modified (&optional session)

  "Set SESSION's modified flag."

  (when (and wg-flag-modified

             (or session (wg-current-session t)))

    (setf (wg-session-modified (or session (wg-current-session t))) t)))

(defun wg-flag-workgroup-modified (&optional workgroup)

  "Set WORKGROUP's and the current session's modified flags."

  (when wg-flag-modified

    (-when-let (or session (wg-current-session t))

      (setf (wg-session-modified it) t))))

    (setf (wg-workgroup-modified workgroup) t)

    (wg-flag-session-modified)))

(defun wg-current-workgroup (&optional noerror frame)

  "Return current workgroup in frame.

Error unless NOERROR, in FRAME if specified."

  (or wg-current-workgroup

      (aif (frame-parameter frame 'wg-current-workgroup-uid)

          (wg-find-workgroup-by :uid it noerror)

        (unless noerror (error "No current workgroup in this frame")))))

(defun wg-previous-workgroup (&optional noerror frame)

  "Return the previous workgroup in FRAME, or error unless NOERROR."

  (aif (frame-parameter frame 'wg-previous-workgroup-uid)

      (wg-find-workgroup-by :uid it noerror)

    (unless noerror (error "No previous workgroup in this frame"))))

(defun wg-set-current-workgroup (workgroup &optional frame)

  "Set the current workgroup to WORKGROUP in FRAME.

WORKGROUP should be a workgroup or nil."

  (set-frame-parameter frame 'wg-current-workgroup-uid

                       (when workgroup (wg-workgroup-uid workgroup))))

(defun wg-set-previous-workgroup (workgroup &optional frame)

  "Set the previous workgroup to WORKGROUP in FRAME.

WORKGROUP should be a workgroup or nil."

  (set-frame-parameter frame 'wg-previous-workgroup-uid

                       (when workgroup (wg-workgroup-uid workgroup))))

(defun wg-current-workgroup-p (workgroup &optional frame)

  "Return t when WORKGROUP is the current workgroup, nil otherwise."

  (awhen (wg-current-workgroup t frame)

    (eq workgroup it)))

(defun wg-previous-workgroup-p (workgroup &optional frame)

  "Return t when WORKGROUP is the previous workgroup, nil otherwise."

  (awhen (wg-previous-workgroup t frame)

    (eq workgroup it)))

(defun wg-get-workgroup (obj &optional noerror)

  "Return a workgroup from OBJ.

If OBJ is a workgroup, return it.

If OBJ is a string, return the workgroup named OBJ, or error unless NOERROR.

If OBJ is nil, return the current workgroup, or error unless NOERROR."

  (cond ((wg-workgroup-p obj) obj)

        ((stringp obj) (wg-find-workgroup-by :name obj noerror))

        ((null obj) (wg-current-workgroup noerror))

        (t (error "Can't get workgroup from type:: %S" (type-of obj)))))

;;; workgroup parameters

;;

;; Quick test:

;; (wg-workgroup-parameters (wg-current-workgroup))

;; (wg-set-workgroup-parameter (wg-current-workgroup) 'test1 t)

;; (wg-workgroup-parameter (wg-current-workgroup) 'test1)

(defun wg-workgroup-parameter (workgroup parameter &optional default)

  "Return WORKGROUP's value for PARAMETER.

If PARAMETER is not found, return DEFAULT which defaults to nil.

WORKGROUP should be accepted by `wg-get-workgroup'."

  (wg-aget (wg-workgroup-parameters (wg-get-workgroup workgroup))

           parameter default))

(defun wg-set-workgroup-parameter (parameter value &optional workgroup)

  "Set PARAMETER to VALUE in a WORKGROUP.

WORKGROUP should be a value accepted by `wg-get-workgroup'.

Return VALUE."

  (-when-let (workgroup (wg-get-workgroup (or workgroup (wg-current-workgroup t)) t))

    (wg-set-parameter (wg-workgroup-parameters workgroup) parameter value)

    (wg-flag-workgroup-modified workgroup)

    value))

(defun wg-remove-workgroup-parameter (parameter &optional workgroup)

  "Remove PARAMETER from WORKGROUP's parameters."

  (-when-let (workgroup (wg-get-workgroup workgroup t))

    (wg-flag-workgroup-modified workgroup)

    (wg-asetf (wg-workgroup-parameters workgroup) (wg-aremove it parameter))))

(defun wg-workgroup-local-value (variable &optional workgroup)

  "Return the value of VARIABLE in WORKGROUP.

WORKGROUP nil defaults to the current workgroup.  If there is no

current workgroup, or if VARIABLE does not have a workgroup-local

binding in WORKGROUP, resolve VARIABLE with `wg-session-local-value'."

  (let ((workgroup (wg-get-workgroup workgroup t)))

    (if (not workgroup) (wg-session-local-value variable)

      (let* ((undefined (cl-gensym))

             (value (wg-workgroup-parameter workgroup variable undefined)))

        (if (not (eq value undefined)) value

          (wg-session-local-value variable))))))

(defalias 'wg-local-value 'wg-workgroup-local-value)

(defun wg-workgroup-saved-wconfig-names (workgroup)

  "Return a new list of the names of all WORKGROUP's saved wconfigs."

  (mapcar 'wg-wconfig-name (wg-workgroup-saved-wconfigs workgroup)))

(defun wg-workgroup-get-saved-wconfig (wconfig-or-name &optional workgroup)

  "Return the wconfig by WCONFIG-OR-NAME from WORKGROUP's saved wconfigs.

WCONFIG-OR-NAME must be either a string or a wconfig.  If

WCONFIG-OR-NAME is a string and there is no saved wconfig with

that name, return nil.  If WCONFIG-OR-NAME is a wconfig, and it

is a member of WORKGROUP's saved wconfigs, return is as given.

Otherwise return nil."

  (let ((wconfigs (wg-workgroup-saved-wconfigs (or workgroup (wg-current-workgroup)))))

    (cl-etypecase wconfig-or-name

      (wg-wconfig (car (memq wconfig-or-name wconfigs)))

      (string (cl-find wconfig-or-name wconfigs

                       :key 'wg-wconfig-name

                       :test 'string=)))))

(defun wg-workgroup-save-wconfig (wconfig &optional workgroup)

  "Add WCONFIG to WORKGROUP's saved wconfigs.

WCONFIG must have a name.  If there's already a wconfig with the

same name in WORKGROUP's saved wconfigs, replace it."

  (let ((name (wg-wconfig-name wconfig)))

    (unless name (error "Attempt to save a nameless wconfig"))

    (setf (wg-workgroup-modified workgroup) t)

    (wg-asetf (wg-workgroup-saved-wconfigs workgroup)

              (cons wconfig (cl-remove name it

                                       :key 'wg-wconfig-name

                                       :test 'string=)))))

(defun wg-workgroup-kill-saved-wconfig (workgroup wconfig-or-name)

  "Delete WCONFIG-OR-NAME from WORKGROUP's saved wconfigs.

WCONFIG-OR-NAME is resolved with `wg-workgroup-get-saved-wconfig'."

  (-when-let (wconfig (wg-workgroup-get-saved-wconfig

                       workgroup wconfig-or-name))

    (wg-asetf (wg-workgroup-saved-wconfigs workgroup) (remq wconfig it)

              (wg-workgroup-modified workgroup) t)))

(defun wg-workgroup-base-wconfig-buf-uids (workgroup)

  "Return a new list of all unique buf uids in WORKGROUP's working wconfig."

  (wg-wconfig-buf-uids (wg-workgroup-base-wconfig workgroup)))

(defun wg-workgroup-saved-wconfigs-buf-uids (workgroup)

  "Return a new list of all unique buf uids in WORKGROUP's base wconfig."

  (cl-reduce 'wg-string-list-union

             (wg-workgroup-saved-wconfigs workgroup)

             :key 'wg-wconfig-buf-uids))

(defun wg-workgroup-all-wconfig-buf-uids (workgroup)

  "Return a new list of all unique buf uids in WORKGROUP's wconfigs."

  (cl-union (wg-workgroup-base-wconfig-buf-uids workgroup)

            (wg-workgroup-saved-wconfigs-buf-uids workgroup)

            :test 'string=))

(defun wg-workgroup-all-buf-uids (workgroup)

  "Return a new list of all unique buf uids in WORKGROUP."

  (cl-reduce 'wg-string-list-union

             (list (wg-workgroup-base-wconfig-buf-uids workgroup)

                   (wg-workgroup-saved-wconfigs-buf-uids workgroup))))

(defun wg-restore-workgroup (workgroup)

  "Restore WORKGROUP in `selected-frame'."

  (let (wg-flag-modified)

    (wg-restore-wconfig-undoably (wg-workgroup-working-wconfig workgroup) t)))

(defun wg-workgroup-list-or-error (&optional noerror)

  "Return the value of `wg-current-session's :workgroup-list slot.

Or scream unless NOERROR."

  (or (wg-workgroup-list)

      (unless noerror (error "No workgroups are defined"))))

(defun wg-find-workgroup-by (slotkey value &optional noerror)

  "Return the workgroup on which ACCESSOR returns VALUE or error."

  (let ((accessor (cl-ecase slotkey

                    (:name 'wg-workgroup-name)

                    (:uid  'wg-workgroup-uid))))

    (or (cl-find value (wg-workgroup-list-or-error noerror) :test 'equal :key accessor)

        (unless noerror

          (error "No are no workgroups with a %S of %S"

                 accessor value)))))

(defun wg-cyclic-nth-from-workgroup (workgroup &optional n)

  "Return the workgroup N places from WORKGROUP in `wg-workgroup-list'."

  (wg-cyclic-nth-from-elt workgroup (wg-workgroup-list-or-error) (or n 1)))

(defun wg-workgroup-names (&optional noerror)

  "Return a list of workgroup names or scream unless NOERROR."

  (mapcar 'wg-workgroup-name (wg-workgroup-list-or-error noerror)))

(defun wg-read-workgroup-name (&optional require-match)

  "Read a workgroup name from `wg-workgroup-names'.

REQUIRE-MATCH to match."

  (ido-completing-read "Workgroup: " (wg-workgroup-names) nil require-match nil nil

                       (awhen (wg-current-workgroup t) (wg-workgroup-name it))))

(defun wg-new-default-workgroup-name ()

  "Return a new, unique, default workgroup name."

  (let ((names (wg-workgroup-names t)) (index -1) result)

    (while (not result)

      (let ((new-name (format "wg%s" (cl-incf index))))

        (unless (member new-name names)

          (setq result new-name))))

    result))

(defun wg-unique-workgroup-name-p (new-name)

  "Return t if NEW-NAME is unique in `wg-workgroup-list', nil otherwise."

  (cl-every (lambda (existing-name) (not (equal new-name existing-name)))

            (wg-workgroup-names t)))

(defun wg-read-saved-wconfig-name (workgroup &optional prompt require-match)

  "Read the name of a saved wconfig, completing on the names of

WORKGROUP's saved wconfigs."

  (ido-completing-read (or prompt "Saved wconfig name: ")

                       (wg-workgroup-saved-wconfig-names workgroup)

                       nil require-match))

(defun wg-read-saved-wconfig (workgroup)

  "Read the name of and return one of WORKGROUP's saved wconfigs."

  (wg-workgroup-get-saved-wconfig

   workgroup (wg-read-saved-wconfig-name workgroup nil t)))

;;; workgroup-list reorganization commands

(defun wg-swap-workgroups ()

  "Swap the previous and current workgroups."

  (interactive)

  (wg-swap-workgroups-in-workgroup-list

   (wg-current-workgroup) (wg-previous-workgroup))

  (wg-fontified-message

    (:cmd "Swapped:  ")

    (wg-workgroup-list-display)))

(defun wg-offset-workgroup-left (&optional workgroup n)

  "Offset WORKGROUP leftward in `wg-workgroup-list' cyclically."

  (interactive (list nil current-prefix-arg))

  (wg-cyclic-offset-workgroup (wg-get-workgroup workgroup) (or n -1))

  (wg-fontified-message

    (:cmd "Offset left: ")

    (wg-workgroup-list-display)))

(defun wg-offset-workgroup-right (&optional workgroup n)

  "Offset WORKGROUP rightward in `wg-workgroup-list' cyclically."

  (interactive (list nil current-prefix-arg))

  (wg-cyclic-offset-workgroup (wg-get-workgroup workgroup) (or n 1))

  (wg-fontified-message

    (:cmd "Offset right: ")

    (wg-workgroup-list-display)))

;;; undo/redo commands

(defun wg-undo-wconfig-change (&optional workgroup)

  "Undo a change to the current workgroup's window-configuration."

  (interactive)

  (let* ((workgroup (wg-get-workgroup workgroup))

         (undid? (wg-workgroup-offset-position-in-undo-list workgroup 1)))

    (wg-fontified-message

      (:cmd "Undo")

      (:cur (if undid? "" "  No more undo info")))))

(defun wg-redo-wconfig-change (&optional workgroup)

  "Redo a change to the current workgroup's window-configuration."

  (interactive)

  (let* ((workgroup (wg-get-workgroup workgroup))

         (redid? (wg-workgroup-offset-position-in-undo-list workgroup -1)))

    (wg-fontified-message

      (:cmd "Redo")

      (:cur (if redid? "" "  No more redo info")))))

(defun wg-undo-once-all-workgroups ()

  "Do what the name says.  Useful for instance when you

accidentally call `wg-revert-all-workgroups' and want to return

all workgroups to their un-reverted state."

  (interactive)

  (mapc 'wg-undo-wconfig-change (wg-workgroup-list-or-error))

  (wg-message "Undid once on all workgroups."))

(defun wg-redo-once-all-workgroups ()

  "Do what the name says.  Probably useless.  Included for

symetry with `wg-undo-once-all-workgroups'."

  (interactive)

  (mapc 'wg-redo-wconfig-change (wg-workgroup-list-or-error))

  (wg-message "Redid once on all workgroups."))

;;; window-tree commands

;;

;; TODO: These are half-hearted.  Clean them up; allow specification of the

;; window-tree depth at which to operate; add complex window creation commands;

;; and add window splitting, deletion and locking commands.

(defun wg-reverse-frame-horizontally (&optional workgroup)

  "Reverse the order of all horizontally split wtrees."

  (interactive)

  (wg-restore-wconfig-undoably

   (wg-reverse-wconfig

    (wg-workgroup-working-wconfig

     (wg-get-workgroup workgroup)))))

(defun wg-reverse-frame-vertically (&optional workgroup)

  "Reverse the order of all vertically split wtrees."

  (interactive)

  (wg-restore-wconfig-undoably

   (wg-reverse-wconfig

    (wg-workgroup-working-wconfig

     (wg-get-workgroup workgroup))

    t)))

(defun wg-reverse-frame-horizontally-and-vertically (&optional workgroup)

  "Reverse the order of all wtrees."

  (interactive)

  (wg-restore-wconfig-undoably

   (wg-reverse-wconfig

    (wg-workgroup-working-wconfig

     (wg-get-workgroup workgroup))

    'both)))

(defun wg-rename-workgroup (workgroup newname)

  "Rename WORKGROUP to NEWNAME."

  (interactive (list nil (wg-read-new-workgroup-name "New name: ")))

  (let* ((workgroup (wg-get-workgroup workgroup))

         (oldname (wg-workgroup-name workgroup)))

    (setf (wg-workgroup-name workgroup) newname)

    (wg-flag-workgroup-modified workgroup)

    (wg-fontified-message

      (:cmd "Renamed: ")

      (:cur oldname)

      (:msg " to ")

      (:cur (wg-workgroup-name workgroup)))))

(defun wg-reset (&optional force)

  "Reset Workgroups.

Resets all frame parameters, buffer-local vars, the current

Workgroups session object, etc."

  (interactive "P")

  (unless (or force wg-no-confirm-on-destructive-operation

              (y-or-n-p "Really reset Workgroups? "))

    (error "Canceled"))

  (wg-reset-internal)

  (wg-fontified-message (:cmd "Reset: ") (:msg "Workgroups")))

(defun wg-query-and-save-if-modified ()

  "Query for save when `wg-modified-p'."

  (or (not (wg-modified-p))

      (when (y-or-n-p "Save modified workgroups? ")

        (wg-save-session))))

(defun wg-create-workgroup (name &optional blank)

  "Create and add a workgroup named NAME.

Optional argument BLANK non-nil (set interactively with a prefix

arg) means use a blank, one window window-config.  Otherwise use

the current window-configuration.  Keep in mind that even though

the current window-config may be used, other parameters of the

current workgroup are not copied to the created workgroup.  For

that, use `wg-clone-workgroup'."

  (interactive (list (wg-read-new-workgroup-name) current-prefix-arg))

  (wg-switch-to-workgroup (wg-make-and-add-workgroup name blank))

  (wg-fontified-message

    (:cmd "Created: ") (:cur name) "  " (wg-workgroup-list-display)))

(defun wg-clone-workgroup (workgroup name)

  "Create and add a clone of WORKGROUP named NAME.

Keep in mind that only WORKGROUP's top level alist structure is

copied, so destructive operations on the keys or values of

WORKGROUP will be reflected in the clone, and vice-versa.  Be

safe -- don't mutate them."

  (interactive (list nil (wg-read-new-workgroup-name)))

  (let* ((workgroup (wg-get-workgroup workgroup))

         (clone (wg-copy-workgroup workgroup)))

    (setf (wg-workgroup-name clone) name

          (wg-workgroup-uid clone) (wg-generate-uid))

    (when (wg-check-and-add-workgroup clone)

      (wg-flag-workgroup-modified clone))

    (wg-set-workgroup-working-wconfig

     clone (wg-workgroup-working-wconfig workgroup))

    (wg-switch-to-workgroup clone)

    (wg-fontified-message

      (:cmd "Cloned: ")

      (:cur (wg-workgroup-name workgroup))

      (:msg " to ")

      (:cur name) "  "

      (wg-workgroup-list-display))))

(defun wg-switch-to-workgroup (workgroup &optional noerror)

  "Switch to WORKGROUP.

NOERROR means fail silently."

  (interactive (list (wg-read-workgroup-name)))

  (fset 'buffer-list wg-buffer-list-original)

@@ -3885,731 +3883,731 @@ ring, starting at the front."

    (unless (or wg-no-confirm-on-destructive-operation

                (y-or-n-p "Really delete all other workgroups? "))

      (error "Cancelled"))

    (dolist (w (wg-workgroup-list-or-error))

      (unless (eq w workgroup)

        (wg-delete-workgroup w)))

    (unless (wg-current-workgroup-p workgroup)

      (wg-switch-to-workgroup workgroup))

    (wg-fontified-message

      (:cmd "Deleted: ")

      (:msg "All workgroups but ")

      (:cur (wg-workgroup-name workgroup)))))

(defun wg-revert-workgroup (&optional workgroup)

  "Restore WORKGROUP's window configuration to its state at the last save."

  (interactive)

  (let* ((workgroup (wg-get-workgroup workgroup))

         (base-wconfig (wg-workgroup-base-wconfig workgroup)))

    (if (wg-current-workgroup-p workgroup)

        (wg-restore-wconfig-undoably base-wconfig)

      (wg-add-wconfig-to-undo-list workgroup base-wconfig))

    (wg-fontified-message

      (:cmd "Reverted: ")

      (:cur (wg-workgroup-name workgroup)))))

(defun wg-revert-all-workgroups ()

  "Revert all workgroups to their base wconfigs.

Only workgroups' working-wconfigs in `selected-frame' are

reverted."

  (interactive)

  (mapc #'wg-revert-workgroup (wg-workgroup-list-or-error))

  (wg-fontified-message

    (:cmd "Reverted: ")

    (:msg "All")))

(defun wg-workgroup-state-table (&optional frame)

  "Return FRAME's workgroup table, creating it first if necessary."

  (or (frame-parameter frame 'wg-workgroup-state-table)

      (let ((wtree (make-hash-table :test 'equal)))

        (set-frame-parameter frame 'wg-workgroup-state-table wtree)

        wtree)))

(defun wg-get-workgroup-state (workgroup &optional frame)

  "Return WORKGROUP's state table in a FRAME."

  (let ((uid (wg-workgroup-uid workgroup))

        (state-table (wg-workgroup-state-table frame)))

    (or (gethash uid state-table)

        (let ((wgs (wg-make-workgroup-state

                    :undo-pointer 0

                    :undo-list

                    (list (or (wg-workgroup-selected-frame-wconfig workgroup)

                              (wg-workgroup-base-wconfig workgroup))))))

          (puthash uid wgs state-table)

          wgs))))

(defmacro wg-with-undo (workgroup spec &rest body)

  "Bind WORKGROUP's undo state to SPEC and eval BODY."

  (declare (indent 2))

  (wg-dbind (state undo-pointer undo-list) spec

    `(let* ((,state (wg-get-workgroup-state ,workgroup))

            (,undo-pointer (wg-workgroup-state-undo-pointer ,state))

            (,undo-list (wg-workgroup-state-undo-list ,state)))

       ,@body)))

(defun wg-flag-just-exited-minibuffer ()

  "Added to `minibuffer-exit-hook'."

  (setq wg-just-exited-minibuffer t))

(defun wg-flag-window-configuration-changed ()

  "Set `wg-window-configuration-changed' to t.

But only if not the minibuffer was just exited.  Added to

`window-configuration-change-hook'."

  (if wg-just-exited-minibuffer

      (setq wg-just-exited-minibuffer nil)

    (setq wg-window-configuration-changed t)))

(defun wg-unflag-undoify-window-configuration-change ()

  "Set `wg-undoify-window-configuration-change' to nil, exempting

from undoification any window-configuration changes caused by the

current command."

  (setq wg-undoify-window-configuration-change nil))

(defun wg-set-workgroup-working-wconfig (workgroup wconfig)

  "Set the working-wconfig of WORKGROUP to WCONFIG."

  (wg-flag-workgroup-modified workgroup)

  (setf (wg-workgroup-selected-frame-wconfig workgroup) wconfig)

  (wg-with-undo workgroup (state undo-pointer undo-list)

    (setcar (nthcdr undo-pointer undo-list) wconfig)))

(defun wg-add-wconfig-to-undo-list (workgroup wconfig)

  "Add WCONFIG to WORKGROUP's undo list, truncating its future if necessary."

  (wg-with-undo workgroup (state undo-pointer undo-list)

    (let ((undo-list (cons nil (nthcdr undo-pointer undo-list))))

      (awhen (nthcdr wg-wconfig-undo-list-max undo-list) (setcdr it nil))

      (setf (wg-workgroup-state-undo-list state) undo-list))

    (setf (wg-workgroup-state-undo-pointer state) 0))

  (wg-set-workgroup-working-wconfig workgroup wconfig))

(defun wg-workgroup-working-wconfig (workgroup &optional noupdate)

  "Return WORKGROUP's working-wconfig.

If WORKGROUP is the current workgroup in `selected-frame', and

NOUPDATE is nil, set its working wconfig in `selected-frame' to

`wg-current-wconfig' and return the updated wconfig.  Otherwise

return WORKGROUP's current undo state."

  (if (and (not noupdate) (wg-current-workgroup-p workgroup))

      (wg-set-workgroup-working-wconfig workgroup (wg-current-wconfig))

    (wg-with-undo workgroup (state undo-pointer undo-list)

      (nth undo-pointer undo-list))))

(defun wg-update-current-workgroup-working-wconfig ()

  "Update `selected-frame's current workgroup's working-wconfig with `wg-current-wconfig'."

  (awhen (wg-current-workgroup t)

    (wg-set-workgroup-working-wconfig it (wg-current-wconfig))))

(defun wg-restore-wconfig-undoably (wconfig &optional noundo)

  "Restore WCONFIG in `selected-frame', saving undo information.

Skip undo when NOUNDO."

  (when noundo (wg-unflag-undoify-window-configuration-change))

  (wg-update-current-workgroup-working-wconfig)

  (wg-restore-wconfig wconfig))

(defun wg-workgroup-offset-position-in-undo-list (workgroup increment)

  "Increment WORKGROUP's undo-pointer by INCREMENT.

Also restore the wconfig at the incremented undo-pointer if

WORKGROUP is current."

  (wg-with-undo workgroup (state undo-pointer undo-list)

    (let ((new-pointer (+ undo-pointer increment)))

      (when (wg-within new-pointer 0 (length undo-list))

        (when (wg-current-workgroup-p workgroup)

          (wg-restore-wconfig-undoably (nth new-pointer undo-list) t))

        (setf (wg-workgroup-state-undo-pointer state) new-pointer)))))

(defun wg-undoify-window-configuration-change ()

  "Conditionally `wg-add-wconfig-to-undo-list'.

Added to `post-command-hook'."

  (when (and

         wg-window-configuration-changed         ;; When the window config has changed,

         wg-undoify-window-configuration-change  ;; and undoification is still on for the current command

         (wg-minibuffer-inactive-p))             ;; and the change didn't occur while the minibuffer is active,

    (-when-let (workgroup (wg-current-workgroup t))  ;; and there's a current workgroup,

      ;; add the current wconfig to that workgroup's undo list:

      (wg-add-wconfig-to-undo-list workgroup (wg-current-wconfig))))

  ;; Reset all flags no matter what:

  (setq wg-window-configuration-changed nil

        wg-undoify-window-configuration-change t

        wg-already-updated-working-wconfig nil))

(defun wg-update-working-wconfig-hook ()

  "Used in before advice on all functions that trigger `window-configuration-change-hook'.

To save up to date undo info before the change."

  (when (and (not wg-already-updated-working-wconfig)

             (wg-minibuffer-inactive-p))

    (wg-update-current-workgroup-working-wconfig)

    (setq wg-already-updated-working-wconfig t)))

(defun wg-workgroup-gc-buf-uids (workgroup)

  "Remove buf uids from WORKGROUP that have no referent in `wg-buf-list'."

  (wg-asetf (wg-workgroup-strong-buf-uids workgroup)

            (cl-remove-if-not 'wg-find-buf-by-uid it)

            (wg-workgroup-weak-buf-uids workgroup)

            (cl-remove-if-not 'wg-find-buf-by-uid it)))

(defun wg-display-internal (elt-fn list)

  "Return display string built by calling ELT-FN on each element of LIST."

  (let ((div (wg-add-face :div wg-list-display-decor-divider))

        (wwidth (window-width (minibuffer-window)))

        (i -1)

        (str))

    (setq str

          (wg-fontify

            (:brace wg-list-display-decor-left-brace)

            (if (not list) (funcall elt-fn nil nil)

              (wg-doconcat (elt list div) (funcall elt-fn elt (cl-incf i))))

            (:brace wg-list-display-decor-right-brace)))

    ;; (subseq str 0 wwidth)

))

(defun wg-workgroup-list-display (&optional workgroup-list)

  "Return the WORKGROUP-LIST display string.

The string contains the names of all workgroups in `wg-workgroup-list',

decorated with faces, dividers and strings identifying the

current and previous workgroups."

  (wg-display-internal 'wg-workgroup-display

                       (or workgroup-list (wg-workgroup-list))))

(defun wg-create-first-wg ()

  "Create a first workgroup if needed."

  (when (and workgroups-mode

             wg-session-load-on-start

             (= (length (wg-workgroup-list)) 0))

    (wg-create-workgroup wg-first-wg-name)

    (wg-mark-everything-unmodified)))

(defun wg-pickel-workgroup-parameters (workgroup)

  "Return a copy of WORKGROUP after pickeling its parameters.

If WORKGROUP's parameters are non-nil, otherwise return

WORKGROUP."

  (if (not (wg-workgroup-parameters workgroup)) workgroup

    (let ((copy (wg-copy-workgroup workgroup)))

      (wg-asetf (wg-workgroup-parameters copy) (wg-pickel it))

      copy)))

(defun wg-unpickel-workgroup-parameters (workgroup)

  "If WORKGROUP's parameters are non-nil, return a copy of

WORKGROUP after unpickeling its parameters. Otherwise return

WORKGROUP."

  (if (not (wg-workgroup-parameters workgroup)) workgroup

    (let ((copy (wg-copy-workgroup workgroup)))

      (wg-asetf (wg-workgroup-parameters copy) (wg-unpickel it))

      copy)))

(defun wg-delete-workgroup (workgroup)

  "Remove WORKGROUP from `wg-workgroup-list'.

Also delete all references to it by `wg-workgroup-state-table',

`wg-current-workgroup' and `wg-previous-workgroup'."

  (dolist (frame (frame-list))

    (remhash (wg-workgroup-uid workgroup) (wg-workgroup-state-table frame))

    (when (wg-current-workgroup-p workgroup frame)

      (wg-set-current-workgroup nil frame))

    (when (wg-previous-workgroup-p workgroup frame)

      (wg-set-previous-workgroup nil frame)))

  (setf (wg-workgroup-list) (remove workgroup (wg-workgroup-list-or-error)))

  (wg-flag-session-modified)

  workgroup)

(defun wg-add-workgroup (workgroup &optional index)

  "Add WORKGROUP to `wg-workgroup-list' at INDEX or the end.

If a workgroup with the same name exists, overwrite it."

  (awhen (wg-find-workgroup-by :name (wg-workgroup-name workgroup) t)

    (unless index (setq index (cl-position it (wg-workgroup-list-or-error))))

    (wg-delete-workgroup it))

  (wg-asetf (wg-workgroup-list)

            (wg-insert-before workgroup it (or index (length it))))

  (wg-flag-session-modified)

  workgroup)

(defun wg-check-and-add-workgroup (workgroup)

  "Add WORKGROUP to `wg-workgroup-list'.

Ask to overwrite if a workgroup with the same name exists."

  (let ((name (wg-workgroup-name workgroup))

        (uid (wg-workgroup-uid workgroup)))

    (when (wg-find-workgroup-by :uid uid t)

      (error "A workgroup with uid %S already exists" uid))

    (when (wg-find-workgroup-by :name name t)

      (unless (or wg-no-confirm-on-destructive-operation

                  (y-or-n-p (format "%S exists. Overwrite? " name)))

        (error "Cancelled"))))

  (wg-add-workgroup workgroup))

(defun wg-make-and-add-workgroup (name &optional blank)

  "Create a workgroup named NAME with current `window-tree'.

If BLANK - then just scratch buffer.

Add it with `wg-check-and-add-workgroup'."

  (wg-check-and-add-workgroup

   (wg-make-workgroup

    :name name

    :base-wconfig (if blank (wg-make-blank-wconfig)

                    (wg-current-wconfig)))))

(defun wg-get-workgroup-create (workgroup)

  "Return the workgroup specified by WORKGROUP, creating a new one if needed.

If `wg-get-workgroup' on WORKGROUP returns a workgroup, return it.

Otherwise, if WORKGROUP is a string, create a new workgroup with

that name and return it.  Otherwise error."

  (or (wg-get-workgroup workgroup t)

      (if (stringp workgroup)

          (wg-make-and-add-workgroup workgroup)

        (wg-get-workgroup workgroup))))  ; Call this again for its error message

(defun wg-cyclic-offset-workgroup (workgroup n)

  "Offset WORKGROUP's position in `wg-workgroup-list' by N."

  (let ((workgroup-list (wg-workgroup-list-or-error)))

    (unless (member workgroup workgroup-list)

      (error "Workgroup isn't present in `wg-workgroup-list'."))

    (setf (wg-workgroup-list) (wg-cyclic-offset-elt workgroup workgroup-list n)

          (wg-session-modified (wg-current-session)) t)))

(defun wg-swap-workgroups-in-workgroup-list (workgroup1 workgroup2)

  "Swap the positions of WORKGROUP1 and WORKGROUP2 in `wg-workgroup-list'."

  (let ((workgroup-list (wg-workgroup-list-or-error)))

    (when (eq workgroup1 workgroup2)

      (error "Can't swap a workgroup with itself"))

    (unless (and (memq workgroup1 workgroup-list)

                 (memq workgroup2 workgroup-list))

      (error "Both workgroups aren't present in `wg-workgroup-list'."))

    (setf (wg-workgroup-list) (wg-util-swap workgroup1 workgroup2 workgroup-list)

          (wg-session-modified (wg-current-session)) t)))

(defun wg-session-uids-consistent-p ()

  "Return t if there are no duplicate bufs or buf uids in the wrong places.

nil otherwise."

  (and (not (wg-dups-p (wg-buf-list) :key 'wg-buf-uid :test 'string=))

       (not (wg-dups-p (wg-workgroup-list) :key 'wg-workgroup-uid :test 'string=))))

(defun wg-find-session-file (filename)

  "Load a session visiting FILENAME, creating one if none already exists."

  (interactive "FFind session file: ")

  (cond ((file-exists-p filename)

         ;; TODO: handle errors when reading object

         (let ((session (read (f-read-text filename))))

           (unless (wg-session-p session)

             (error "%S is not a Workgroups session file." filename))

           (setf (wg-session-file-name session) filename)

           (wg-reset-internal (wg-unpickel-session-parameters session)))

         (if wg-control-frames (wg-restore-frames))

         (awhen (wg-workgroup-list)

           (if (and wg-open-this-wg

                    (member wg-open-this-wg (wg-workgroup-names)))

               (wg-switch-to-workgroup wg-open-this-wg)

             (if (and wg-load-last-workgroup

                      (member (wg-session-parameter 'last-workgroup) (wg-workgroup-names)))

                 (wg-switch-to-workgroup (wg-session-parameter 'last-workgroup))

               (wg-switch-to-workgroup (car it)))

))

         (wg-fontified-message (:cmd "Loaded: ") (:file filename))

         (wg-mark-everything-unmodified))

(t

         (wg-query-and-save-if-modified)

         (wg-reset-internal (wg-make-session :file-name filename))

         (wg-fontified-message (:cmd "(New Workgroups session file)")))))

(defalias 'wg-open-session 'wg-find-session-file)

(defun wg-write-sexp-to-file (sexp file)

  "Write the printable representation of SEXP to FILE."

  (with-temp-buffer

    (let ((print-level nil)  (print-length nil))

      (insert (format "%S" sexp)))

    (write-file file)))

;; FIXME: Duplicate buf names probably shouldn't be allowed.  An unrelated error

;; causes two *scratch* buffers to be present, triggering the "uids don't match"

;; error.  Write something to remove bufs with duplicate names.

(defun wg-perform-session-maintenance ()

  "Perform various maintenance operations on the current Workgroups session."

  (wg-update-current-workgroup-working-wconfig)

  ;; Update every workgroup's base wconfig with `wg-workgroup-update-base-wconfig'

  (dolist (workgroup (wg-workgroup-list))

    (awhen (wg-workgroup-selected-frame-wconfig workgroup)

      (setf (wg-workgroup-base-wconfig workgroup) it

            (wg-workgroup-selected-frame-wconfig workgroup) nil)))

  ;; Garbage collection

  (let ((all-buf-uids (wg-all-buf-uids)))

    (wg-asetf (wg-buf-list)

              (cl-remove-if-not (lambda (uid) (member uid all-buf-uids)) it

                                :key 'wg-buf-uid)))

  (mapc 'wg-workgroup-gc-buf-uids (wg-workgroup-list))  ; Remove buf uids that have no referent in `wg-buf-list'

  (mapc 'wg-update-buffer-in-buf-list (wg-buffer-list-emacs)))

(defun wg-save-session-as (filename &optional confirm)

  "Write the current session into file FILENAME.

This makes the session visit that file, and marks it as not modified.

If optional second arg CONFIRM is non-nil, this function asks for

confirmation before overwriting an existing file.  Interactively,

confirmation is required unless you supply a prefix argument."

  (interactive (list (read-file-name "Save session as: ")

                     (not current-prefix-arg)))

  (when (and confirm (file-exists-p filename))

    (unless (y-or-n-p (format "File `%s' exists; overwrite? " filename))

      (error "Cancelled")))

  (unless (file-writable-p filename)

    (error "File %s can't be written to" filename))

  (wg-perform-session-maintenance)

  (setf (wg-session-file-name (wg-current-session)) filename)

  (setf (wg-session-version (wg-current-session)) wg-version)

  ;; Save opened frames as a session parameter "frame-list".

  ;; Exclude `selected-frame' and daemon one (if any).

  ;; http://stackoverflow.com/questions/21151992/why-emacs-as-daemon-gives-1-more-frame-than-is-opened

  (if wg-control-frames

      (let ((fl (frame-list)))

        ;; TODO: remove using dash

        (mapc (lambda (frame)

                (if (string-equal "initial_terminal" (terminal-name frame))

                    (delete frame fl))) fl)

        (setq fl (delete (selected-frame) fl))

        (let (wg-flag-modified)

          (if (wg-current-session t)

              (wg-set-session-parameter 'frame-list (mapcar 'wg-frame-to-wconfig fl))))))

  (wg-write-sexp-to-file (wg-pickel-all-session-parameters) filename)

  (wg-mark-everything-unmodified)

  (wg-fontified-message (:cmd "Wrote: ") (:file filename)))

  (wg-fontified-message (:cmd "Wrote: ") (:file filename))

  (wg-mark-everything-unmodified))

(defalias 'wg-write-session-file 'wg-save-session-as)

(defun wg-get-session-file ()

  "Return the filename in which to save the session."

  (or (aif (wg-current-session t) (wg-session-file-name it))

      wg-session-file))

;;(read-file-name (format "Save session as [%s]: " wg-session-file))

(defun wg-save-session (&optional force)

  "Save the current Workgroups session if it's been modified.

When FORCE - save session regardless of whether it's been modified."

  (interactive "P")

  (if (and (not (wg-modified-p)) (not force))

      (wg-message "(The session is unmodified)")

    (wg-save-session-as (wg-get-session-file))))

(defun wg-reset-internal (&optional session)

  "Reset Workgroups, setting `wg-current-session' to SESSION.

Resets all frame parameters, buffer-local vars, current session

object, etc.  SESSION nil defaults to a new, blank session."

  (mapc 'wg-reset-frame (frame-list))

  (mapc 'wg-reset-buffer (wg-buffer-list-emacs))

  (setq wg-wconfig-kill-ring nil)

  (setq wg-current-session (or session (wg-make-session))))

(defun wg-all-buf-uids (&optional session buffer-list)

  "Return the union of all SESSION buf-uids and BUFFER-LIST uids."

  (cl-union (cl-reduce 'wg-string-list-union  ; (wg-session-all-buf-uids session)

                       (wg-session-workgroup-list (or session (wg-current-session)))

                       :key 'wg-workgroup-all-buf-uids)

            ;; (wg-buffer-list-all-uids buffer-list)

            (delq nil (mapcar 'wg-buffer-uid (or buffer-list (wg-buffer-list-emacs))))

            :test 'string=))

(defun wg-modified-p ()

  "Return t when the current session or any of its workgroups are modified."

  (aif (wg-current-session t)

      (or (wg-session-modified it)

          (cl-some 'wg-workgroup-modified (wg-workgroup-list)))))

(defun wg-mark-everything-unmodified ()

  "Mark the session and all workgroups as unmodified."

  (setf (wg-session-modified (wg-current-session)) nil)

  (dolist (workgroup (wg-workgroup-list))

    (setf (wg-workgroup-modified workgroup) nil)))

(defun wg-session-parameter (parameter &optional default session)

  "Return session's value for PARAMETER.

If PARAMETER is not found, return DEFAULT which defaults to nil.

SESSION nil defaults to the current session."

  (wg-aget (wg-session-parameters (or session (wg-current-session)))

           parameter default))

(defun wg-set-session-parameter (parameter value &optional session)

  "Set PARAMETER to VALUE in SESSION.

SESSION nil means use the current session.  Return value."

  (let ((session (or session (wg-current-session))))

    (wg-set-parameter (wg-session-parameters session) parameter value)

    (wg-flag-session-modified session)

    value))

(defun wg-remove-session-parameter (parameter &optional session)

  "Remove parameter PARAMETER from SESSION's parameters."

  (let ((session (or session (wg-current-session))))

    (wg-asetf (wg-session-parameters session) (wg-aremove it parameter))

    (setf (wg-session-modified session) t)))

    (wg-flag-session-modified session)))

(defun wg-session-local-value (variable &optional session)

  "Return the value of VARIABLE in SESSION.

SESSION nil defaults to the current session.  If VARIABLE does

not have a session-local binding in SESSION, the value is

resolved by Emacs."

  (let* ((undefined (cl-gensym))

         (value (wg-session-parameter variable undefined session)))

    (if (not (eq value undefined)) value

      (symbol-value variable))))

(defun wg-reset-frame (frame)

  "Reset Workgroups' `frame-parameters' in FRAME to nil."

  (set-frame-parameter frame 'wg-workgroup-state-table nil)

  (set-frame-parameter frame 'wg-current-workgroup-uid nil)

  (set-frame-parameter frame 'wg-previous-workgroup-uid nil))

(defun wg-save-session-on-exit (behavior)

  "Perform session-saving operations based on BEHAVIOR."

  (cl-case behavior

    (ask (wg-query-and-save-if-modified))

    (save (wg-save-session))))

(defun wg-reload-session ()

  "Reload current workgroups session."

  (interactive)

  (let* ((file (wg-get-session-file))

         (exists (file-exists-p file)))

    (condition-case err

        (wg-open-session file)

      (progn

        (wg-create-first-wg)

        (message "Error loading session-file: %s" err))))

        ;; TODO: print what exactly happened

  (wg-create-first-wg))

(defun wg-save-session-on-emacs-exit ()

  "Call `wg-save-session-on-exit' with `wg-emacs-exit-save-behavior'.

Added to `kill-emacs-query-functions'."

  (wg-save-session-on-exit wg-emacs-exit-save-behavior) t)

(defun wg-save-session-on-workgroups-mode-exit ()

  "Call `wg-save-session-on-exit' with `wg-workgroups-mode-exit-save-behavior'.

Called when `workgroups-mode' is turned off."

  (wg-save-session-on-exit wg-workgroups-mode-exit-save-behavior) t)

(defun wg-pickel-all-session-parameters (&optional session)

  "Return a copy of SESSION after pickeling its parameters.

And the parameters of all its workgroups."

  (let ((copy (wg-copy-session (or session (wg-current-session)))))

    (when (wg-session-parameters copy)

      (wg-asetf (wg-session-parameters copy) (wg-pickel it)))

    (wg-asetf (wg-session-workgroup-list copy)

              (cl-mapcar 'wg-pickel-workgroup-parameters it))

    copy))

(defun wg-unpickel-session-parameters (session)

  "Return a copy of SESSION after unpickeling its parameters.

And the parameters of all its workgroups."

  (let ((copy (wg-copy-session session)))

    (when (wg-session-parameters copy)

      (wg-asetf (wg-session-parameters copy) (wg-unpickel it)))

    (wg-asetf (wg-session-workgroup-list copy)

              (cl-mapcar 'wg-unpickel-workgroup-parameters it))

    copy))

(defvar wg-buffer-workgroup nil

  "Associating each buffer with the workgroup.

In which it most recently appeared.")

(make-variable-buffer-local 'wg-buffer-workgroup)

(defun wg-workgroup-associated-buf-uids (&optional workgroup)

  "Return a new list containing all of WORKGROUP's associated buf uids."

  (awhen (or workgroup (wg-current-workgroup t))

    (append (wg-workgroup-strong-buf-uids it)

            (wg-workgroup-weak-buf-uids it))))

(defun wg-workgroup-associated-bufs (workgroup)

  "Return a new list containing all of WORKGROUP's associated bufs."

  (delete nil (mapcar 'wg-find-buf-by-uid

                      (wg-workgroup-associated-buf-uids workgroup))))

(defun wg-workgroup-associated-buffers (workgroup)

  "Return a new list containing all of WORKGROUP's associated buffer objects."

  (delete nil (mapcar 'wg-restore-buffer

                      (wg-workgroup-associated-bufs workgroup))))

(defun wg-workgroup-strongly-associate-bufobj (workgroup bufobj)

  "Strongly associate BUFOBJ with WORKGROUP."

  (let* ((uid (wg-bufobj-uid-or-add bufobj))

         (remp (wg-removef-p uid (wg-workgroup-weak-buf-uids workgroup)

                             :test 'string=))

         (addp (wg-pushnew-p uid (wg-workgroup-strong-buf-uids workgroup)

                             :test 'string=)))

    (when (or remp addp)

      (wg-flag-workgroup-modified workgroup)

      bufobj)))

(defun wg-workgroup-weakly-associate-bufobj (workgroup bufobj)

  "Weakly associate BUFOBJ with WORKGROUP."

  (let* ((uid (wg-bufobj-uid-or-add bufobj))

         (remp (wg-removef-p uid (wg-workgroup-strong-buf-uids workgroup)

                             :test 'string=))

         (addp (wg-pushnew-p uid (wg-workgroup-weak-buf-uids workgroup)

                             :test 'string=)))

    (when (or remp addp)

      (wg-flag-workgroup-modified workgroup)

      bufobj)))

(defun wg-workgroup-associate-bufobj (workgroup bufobj &optional weak)

  "Associate BUFOBJ with WORKGROUP.

WEAK non-nil means weakly associate it.  Otherwise strongly associate it."

  (if weak (wg-workgroup-weakly-associate-bufobj workgroup bufobj)

    (wg-workgroup-strongly-associate-bufobj workgroup bufobj)))

(defun wg-workgroup-dissociate-bufobj (workgroup bufobj)

  "Dissociate BUFOBJ from WORKGROUP."

  (let* ((uid (wg-bufobj-uid-or-add bufobj))

         (rem1p (wg-removef-p uid (wg-workgroup-strong-buf-uids workgroup)

                              :test 'string=))

         (rem2p (wg-removef-p uid (wg-workgroup-weak-buf-uids workgroup)

                              :test 'string=)))

    (when (or rem1p rem2p)

      (wg-flag-workgroup-modified workgroup)

      bufobj)))

(defun wg-workgroup-dissociate-weakly-associated-buffers (workgroup)

  "Dissociate from WORKGROUP all weakly associated buffers."

  (when (wg-workgroup-weak-buf-uids workgroup)

    (wg-flag-workgroup-modified workgroup)

    (setf (wg-workgroup-weak-buf-uids workgroup) nil)))

(defun wg-workgroup-dissociate-strongly-associated-buffers (workgroup)

  "Dissociate from WORKGROUP all strongly associated buffers."

  (when (wg-workgroup-strong-buf-uids workgroup)

    (wg-flag-workgroup-modified workgroup)

    (setf (wg-workgroup-strong-buf-uids workgroup) nil)))

(defun wg-workgroup-dissociate-all-buffers (workgroup)

  "Dissociate from WORKGROUP all its associated buffers."

  (wg-workgroup-dissociate-weakly-associated-buffers workgroup)

  (wg-workgroup-dissociate-strongly-associated-buffers workgroup))

(defun wg-auto-dissociate-buffer-hook ()

  "`kill-buffer-hook' that automatically dissociates buffers from workgroups."

  (when wg-dissociate-buffer-on-kill-buffer

    (awhen (wg-current-workgroup t)

      (wg-workgroup-dissociate-bufobj it (current-buffer)))))

(defun wg-associate-buffer-with-workgroup (&optional workgroup buffer weak)

  "Associate BUFFER with WORKGROUP.

WEAK non-nil means weakly associate BUFFER."

  (interactive (list nil nil current-prefix-arg))

  (let* ((workgroup (wg-get-workgroup workgroup))

         (buffer (or buffer (current-buffer)))

         (bname (buffer-name buffer))

         (wgname (wg-workgroup-name workgroup)))

    (if (wg-workgroup-associate-bufobj workgroup buffer weak)

        (wg-message "%s-associated %S with %s"

                    (if weak "Weakly" "Strongly") bname wgname)

      (wg-message "%S is already associated with %s" bname wgname))))

(defun wg-associate-visible-buffers-with-workgroup (&optional workgroup weak)

  "Associate all buffers visible in `selected-frame' with WORKGROUP.

WEAK non-nil means weakly associate them.  Otherwise strongly

associate them."

  (interactive (list nil current-prefix-arg))

  (let ((workgroup (wg-get-workgroup workgroup))

        (buffers (mapcar 'window-buffer (window-list))))

    (dolist (buffer buffers)

      (wg-workgroup-associate-bufobj workgroup buffer weak))

    (wg-fontified-message

      (:cmd (format "%s associated: " (if weak "Weakly" "Strongly")))

      (wg-display-internal 'wg-buffer-display buffers))))

(defun wg-dissociate-buffer-from-workgroup (&optional workgroup buffer)

  "Dissociate BUFFER from WORKGROUP."

  (interactive (list nil nil))

  (let ((workgroup (wg-get-workgroup workgroup))

        (buffer (or buffer (current-buffer))))

    (wg-message

     (if (wg-workgroup-dissociate-bufobj workgroup buffer)

         "Dissociated %S from %s" "%S isn't associated with %s")

     (wg-buffer-name buffer)

     (wg-workgroup-name workgroup))))

(defun wg-associate-buffers (workgroup window-or-emacs-window-tree)

  "Associate the buffers visible in window elements of

WINDOW-OR-EMACS-WINDOW-TREE with the given WORKGROUP.

WINDOW-OR-EMACS-WINDOW-TREE must be either a window or a tree of

the form produced by `(car (window-tree))'."

  (if (windowp window-or-emacs-window-tree)

      (with-current-buffer (window-buffer window-or-emacs-window-tree)

        (setq wg-buffer-workgroup workgroup))

    (dolist (w (cddr window-or-emacs-window-tree))

      (when w (wg-associate-buffers workgroup w)))))

(defun wg-workgroup-bufobj-association-type (workgroup bufobj)

  "Return BUFOBJ's association-type in WORKGROUP, or nil if unassociated."

  (let ((uid (wg-bufobj-uid-or-add bufobj)))

    (or (and (member uid (wg-workgroup-strong-buf-uids workgroup)) 'strong)

        (and (member uid (wg-workgroup-weak-buf-uids workgroup)) 'weak))))

(defun wg-associate-frame-buffers ()

  "Associate visible buffers with the current workgroup.

Unless it is currently being deactivated."

  (awhen (wg-current-workgroup :noerror)

    (unless (member it wg-deactivation-list)

      (wg-associate-buffers it (car (window-tree))))))

(defun wg-add-or-remove-workgroups-hooks (remove)

  "Add or remove all of Workgroups' hooks, depending on REMOVE."

  (wg-add-or-remove-hooks

   remove

   'kill-emacs-query-functions       'wg-save-session-on-emacs-exit

   'delete-frame-hook                'wg-update-working-wconfig-on-delete-frame

   'wg-pre-window-configuration-change-hook 'wg-update-working-wconfig-hook

   'window-configuration-change-hook 'wg-flag-window-configuration-changed

   'post-command-hook                'wg-undoify-window-configuration-change

   'minibuffer-exit-hook             'wg-flag-just-exited-minibuffer

   'kill-buffer-hook                 'wg-update-buffer-in-buf-list

   'kill-buffer-hook                 'wg-auto-dissociate-buffer-hook

   ;;'window-configuration-change-hook 'wg-associate-frame-buffers

))

;;;###autoload

(defun workgroups-mode (&optional arg)

  "Turn `workgroups-mode' on and off.

ARG is nil - toggle

ARG >= 1   - turn on

ARG == 0   - turn off

ARG is anything else, turn on `workgroups-mode'."

  (interactive (list current-prefix-arg))

  (setq workgroups-mode

        (cond ((not arg) (not workgroups-mode))

              ((integerp arg) (if (> arg 0) t nil))

              (t)))

  (cond

   (workgroups-mode

    (if (boundp 'desktop-restore-frames)

        (setq desktop-restore-frames nil))

    (wg-reset-internal)

    (wg-add-workgroups-mode-minor-mode-entries)

    (wg-enable-all-advice)

    (wg-add-or-remove-workgroups-hooks nil)

    (wg-change-modeline)

    ;; Load session

    (when (and wg-session-load-on-start

               (file-exists-p wg-session-file))

      (condition-case err

          (wg-open-session wg-session-file)

        (error (message "Error finding `wg-session-file': %s" err))))

    (run-hooks 'workgroups-mode-hook))

(t

    (wg-save-session-on-workgroups-mode-exit)

    (wg-disable-all-advice)

    (wg-add-or-remove-workgroups-hooks t)

    (wg-remove-mode-line-display)

    (run-hooks 'workgroups-mode-exit-hook)))

  (wg-fontified-message

    (:cmd "Workgroups Mode: ") (:msg (if workgroups-mode "on" "off")))

  (wg-create-first-wg)

  workgroups-mode)

;;;###autoload

(defun wg-help ()

  "Just call `apropos-command' on \"^wg-\".

There used to be a bunch of help-buffer construction stuff here,

including a `wg-help' variable that basically duplicated every

command's docstring;  But why, when there's `apropos-command'?"

  (interactive)

  (apropos-command "^wg-"))

;; Remove after some time

(defalias 'wg-switch-to-buffer 'switch-to-buffer)

(provide 'workgroups2)

;;; workgroups2.el ends here