(set-buffer speedbar-buffer)

            (speedbar-mode)

            (speedbar-reconfigure-keymaps)

            (speedbar-update-contents)

            (speedbar-set-timer 1)

            (set-window-dedicated-p (get-buffer-window bufname) t)

            (switch-to-buffer bufname)))

        (current-buffer)

        ))))

(defun wg-serialize-speedbar-buffer (buffer)

  "Serialize speedbar BUFFER."

  (with-current-buffer buffer

    (if (fboundp 'speedbar-mode)

        (when (eq major-mode 'speedbar-mode)

          (list 'wg-deserialize-speedbar-buffer

                (list default-directory)

                )))))

(defun wg-deserialize-slime-buffer (buf)

  "Deserialize `slime' buffer BUF."

  (when (require 'slime nil 'noerror)

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

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

            (arguments (nth 1 args)))

        (when (and (fboundp 'slime-start*)

                   (fboundp 'slime-process))

          (save-window-excursion

            (slime-start* arguments))

          (switch-to-buffer (process-buffer (slime-process)))

          (current-buffer))))))

;; `comint-mode'  (general mode for all shells)

;;

;; It may have different shells. So we need to determine which shell is

;; now in `comint-mode' and how to restore it.

;;

;; Just executing `comint-exec' may be not enough because we can miss

;; some hooks or any other stuff that is executed when you run a

;; specific shell.

(defun wg-serialize-comint-buffer (buffer)

  "Serialize comint BUFFER."

  (with-current-buffer buffer

    (if (fboundp 'comint-mode)

        (when (eq major-mode 'comint-mode)

          ;; `slime-inferior-lisp-args' var is used when in `slime'

          (when (and (boundp 'slime-inferior-lisp-args)

                     slime-inferior-lisp-args)

            (list 'wg-deserialize-slime-buffer

                  (list default-directory slime-inferior-lisp-args)

                  ))))))

;; inf-mongo

;; https://github.com/tobiassvn/inf-mongo

;; `mongo-command' - command used to start inferior mongo

(wg-support 'inf-mongo-mode 'inf-mongo

  `((serialize . ,(lambda (buffer)

                    (if (boundp 'inf-mongo-command) inf-mongo-command)))

    (deserialize . ,(lambda (buffer vars)

                      (save-window-excursion

                        (when (fboundp 'inf-mongo)

                          (inf-mongo vars)))

                      (when (get-buffer "*mongo*")

                        (switch-to-buffer "*mongo*")

                        (goto-char (point-max)))))))

(defun wg-temporarily-rename-buffer-if-exists (buffer)

  "Rename BUFFER if it exists."

  (when (get-buffer buffer)

    (with-current-buffer buffer

      (rename-buffer "*wg--temp-buffer*" t))))

;; SML shell

;; Functions to serialize deserialize inferior sml buffer

;; `inf-sml-program' is the program run as inferior sml, is the

;; `inf-sml-args' are the extra parameters passed, `inf-sml-host'

;; is the host on which sml was running when serialized

(wg-support 'inferior-sml-mode 'sml-mode

  `((serialize . ,(lambda (buffer)

                    (list (if (boundp 'sml-program-name) sml-program-name)

                          (if (boundp 'sml-default-arg) sml-default-arg)

                          (if (boundp 'sml-host-name) sml-host-name))))

    (deserialize . ,(lambda (buffer vars)

                      (wg-dbind (program args host) vars

                        (save-window-excursion

                          ;; If a inf-sml buffer already exists rename it temporarily

                          ;; otherwise `run-sml' will simply switch to the existing

                          ;; buffer, however we want to create a separate buffer with

                          ;; the serialized name

                          (let* ((inf-sml-buffer-name (concat "*"

                                                              (file-name-nondirectory program)

                                                              "*"))

                                 (existing-sml-buf (wg-temporarily-rename-buffer-if-exists

                                                    inf-sml-buffer-name)))

                            (with-current-buffer (run-sml program args host)

                              ;; Rename the buffer

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

                              ;; Now we can re-rename the previously renamed buffer

                              (when existing-sml-buf

                                (with-current-buffer existing-sml-buf

                                  (rename-buffer inf-sml-buffer-name t))))))

                        (switch-to-buffer (wg-buf-name buffer))

                        (goto-char (point-max)))))))

;; Geiser repls

;; http://www.nongnu.org/geiser/

(wg-support 'geiser-repl-mode 'geiser

  `((save . (geiser-impl--implementation))

    (deserialize . ,(lambda (buffer vars)

                      (when (fboundp 'run-geiser)

                        (wg-dbind (impl) vars

                          (run-geiser impl)

                          (goto-char (point-max))))

                      (switch-to-buffer (wg-buf-name buffer))))))

;; w3m-mode

(wg-support 'w3m-mode 'w3m

  `((save . (w3m-current-url))

    (deserialize . ,(lambda (buffer vars)

                      (wg-dbind (url) vars

                        (w3m-goto-url url))))))

;; notmuch

(wg-support 'notmuch-hello-mode 'notmuch

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

                      (notmuch)

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

;; Wanderlust modes:

;; WL - folders

;;(defun wg-deserialize-wl-folders-buffer (buf)

;;  ""

;;  (if (fboundp 'wl)

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

;;        ;;(when (not (eq major-mode 'wl-folder-mode))

;;        (wl)

;;        (goto-char (point-max))

;;        (current-buffer)

;;        )))

;;

;;(defun wg-serialize-wl-folders-buffer (buffer)

;;  ""

;;  (if (fboundp 'wl)

;;      (with-current-buffer buffer

;;        (when (eq major-mode 'wl-folder-mode)

;;          (list 'wg-deserialize-wl-folders-buffer

;;                )))))

;; WL - summary mode (list of mails)

;;(defun wg-deserialize-wl-summary-buffer (buf)

;;  ""

;;  (interactive)

;;  (if (fboundp 'wl)

;;      (wg-dbind (this-function param-list) (wg-buf-special-data buf)

;;        (when (not (eq major-mode 'wl-summary-mode))

;;          (let ((fld-name (car param-list)))

;;            ;;(switch-to-buffer "*scratch*")

;;            ;;(wl)

;;            ;;(wl-folder-jump-folder fld-name)

;;            ;;(message fld-name)

;;            ;;(goto-char (point-max))

;;            ;;(insert fld-name)

;;            (current-buffer)

;;          )))))

;;

;;(defun wg-serialize-wl-summary-buffer (buffer)

;;  ""

;;  (if (fboundp 'wl)

;;      (with-current-buffer buffer

;;        (when (eq major-mode 'wl-summary-mode)

;;          (list 'wg-deserialize-wl-summary-buffer

;;                (wg-take-until-unreadable (list wl-summary-buffer-folder-name))

;;                )))))

;;

;;

;;;; mime-view-mode

;;

;;(defun wg-deserialize-mime-view-buffer (buf)

;;  ""

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

;;    (when (not (eq major-mode 'mime-view-mode))

;;      ;;(wl-summary-enter-handler 3570)     ; only in wl-summary-mode

;;      ;;(wl-summary-enter-handler)     ; only in wl-summary-mode

;;      (current-buffer)

;;      )))

;;

;;(defun wg-serialize-mime-view-buffer (buffer)

;;  ""

;;  (with-current-buffer buffer

;;    (when (eq major-mode 'mime-view-mode)

;;      (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-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."

  (unless workgroup

    (setq workgroup (wg-get-workgroup nil t)))

  (when (and wg-flag-modified workgroup)

    (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)