"Return ID's KEY's value in `wg-buffer-list-filter-definitions'.

Lots of possible errors here because

`wg-buffer-list-filter-definitions' can be modified by the user."

  (let ((slot-num (case key (symbol 0) (indicator 1) (constructor 2))))

    (if (not slot-num)

        (unless noerror

          (error "`%S' is not a valid buffer-list-filter definition slot" key))

      (let* ((id (wg-get-buffer-list-filter-id-flexibly id))

             (entry (assq id (wg-local-value

                              'wg-buffer-list-filter-definitions))))

        (if (not entry)

            (unless noerror

              (error "`%S' is an undefined buffer-list-filter" id))

          (or (nth slot-num entry)

              (unless noerror

                (error "Slot `%S' is undefined in `%S's definition"

                       key id))))))))

(defun wg-filtered-buffer-list (&optional names workgroup bfl-id initial)

  "Return a filtered buffer-list from NAMES, WORKGROUP, BLF-ID and INITIAL.

NAMES non-nil means return a list of buffer-names instead of buffer objects.

WORKGROUP non-nil should be any workgroup identifier accepted by

`wg-get-workgroup'.

BLF-ID non-nil should be the identifier of a defined buffer-list-filter.

It defaults to `wg-get-buffer-list-filter-val'.

INITIAL non-nil should be an initial buffer-list to filter.  It defaults to

`wg-interesting-buffers'."

  (let ((buffer-list (funcall (wg-get-buffer-list-filter-val

                               (wg-get-buffer-list-filter-id-flexibly bfl-id)

                               'constructor)

                              (wg-get-workgroup workgroup)

                              (or initial (wg-interesting-buffers)))))

    (if names (mapcar 'wg-buffer-name buffer-list) buffer-list)))

;; buffer-list filters

(defun wg-buffer-list-filter-all (workgroup initial)

  "Return all buffers in INITIAL."

  initial)

(defun wg-buffer-list-filter-associated (workgroup initial)

  "Return only those buffers associated with WORKGROUP."

  (wg-workgroup-associated-buffers workgroup initial))

(defun wg-buffer-list-filter-unassociated (workgroup initial)

  "Return only those buffer unassociated with WORKGROUP."

  (let ((buffers (wg-workgroup-associated-buffers workgroup initial)))

    (wg-remove-if (lambda (buffer) (member buffer buffers)) initial)))

;; buffer-list filtration utils

(defun wg-filter-buffer-list-by-regexp (regexp buffer-list)

  "Return only those buffers in BUFFER-LIST with names matching REGEXP."

  (wg-remove-if-not (lambda (bname) (string-match regexp bname))

                 buffer-list :key 'buffer-name))

(defun wg-filter-buffer-list-by-root-dir (root-dir buffer-list)

  "Return only those buffers in BUFFER-LIST visiting files undo ROOT-DIR."

  (wg-remove-if-not (lambda (f) (when f (wg-file-under-root-path-p root-dir f)))

                 buffer-list :key 'buffer-file-name))

(defun wg-filter-buffer-list-by-major-mode (major-mode buffer-list)

  "Return only those buffers in BUFFER-LIST in major-mode MAJOR-MODE."

  (wg-remove-if-not (lambda (mm) (eq mm major-mode))

                 buffer-list :key 'wg-buffer-major-mode))

;; Example custom buffer-list-filters

(defun wg-buffer-list-filter-irc (workgroup buffer-list)

  "Return only those buffers in BUFFER-LIST with names starting in \"#\"."

  (wg-filter-buffer-list-by-regexp "^#" buffer-list))

(defun wg-buffer-list-filter-home-dir (workgroup buffer-list)

  "Return only those buffers in BUFFER-LIST visiting files under ~/."

  (wg-filter-buffer-list-by-root-dir "~/" buffer-list))

(defun wg-buffer-list-filter-elisp (workgroup buffer-list)

  "Return only those buffers in BUFFER-LIST in `emacs-lisp-mode'."

  (wg-filter-buffer-list-by-major-mode 'emacs-lisp-mode buffer-list))

(defun wg-buffer-list-filter-home-dir->elisp (workgroup buffer-list)

  "Example of chaining buffer-list filters.

This returns all buffers under \"~/\" that are also in `emacs-lisp-mode'."

  (wg-buffer-list-filter-elisp

   nil (wg-buffer-list-filter-home-dir nil buffer-list)))

;; buffer-list-filter context

(defun wg-buffer-list-filter-order (command)

  "Return WORKGROUP's buffer-list-filter order for COMMAND, or a default."

  (let ((bfo (wg-local-value 'wg-buffer-list-filter-order-alist)))

    (or (wg-aget bfo command) (wg-aget bfo 'default))))

(defmacro wg-prior-mapping (mode command)

  "Return whatever COMMAND would call if MODE wasn't on."

  `(or (let (,mode) (command-remapping ,command)) ,command))

(defun wg-filter-buffer-list-p ()

  "Return the current workgroup when buffer-list-filters are on."

  (and workgroups-mode wg-buffer-list-filtration-on (wg-current-workgroup t)))

(defmacro wg-with-buffer-list-filters (command &rest body)

  "Create buffer-list filter context for COMMAND, and eval BODY.

Binds `wg-current-buffer-list-filter-id' in BODY."

  (declare (indent 1))

  (wg-with-gensyms (order status)

    `(let* ((wg-previous-minibuffer-contents nil)

            (,order (wg-buffer-list-filter-order ,command)))

       (catch 'wg-result

         (while 'your-mom

           (let* ((wg-current-buffer-list-filter-id (car ,order))

                  (,status (catch 'wg-action (list 'done (progn ,@body)))))

             (case (car ,status)

               (done (throw 'wg-result (cadr ,status)))

               (next (setq ,order (wg-rotate-list ,order 1))

                     (setq wg-previous-minibuffer-contents (cadr ,status)))

               (prev (setq ,order (wg-rotate-list ,order -1))

                     (setq wg-previous-minibuffer-contents

                           (cadr ,status))))))))))

;;; workgroup working-wconfig and wconfig undo/redo

(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 FRAME's WORKGROUP's state table."

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

      (wg-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'."

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

  (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

         ;; When the window config has changed,

         wg-window-configuration-changed

         ;; and undoification is still on for the current command

         wg-undoify-window-configuration-change

         ;; and the change didn't occur while the minibuffer is active,

         (wg-minibuffer-inactive-p))

    ;; and there's a current workgroup,

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

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

;;; base wconfig updating

(defun wg-update-all-base-wconfigs ()

  "Update every workgroup's base wconfig with

`wg-workgroup-update-base-wconfig'."

  (dolist (workgroup (wg-workgroup-list))

    (wg-awhen (wg-workgroup-selected-frame-wconfig workgroup)

      (setf (wg-workgroup-base-wconfig workgroup) it

            (wg-workgroup-selected-frame-wconfig workgroup) nil))))

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

;;; workgroup saved wconfigs

(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 (workgroup wconfig-or-name)

  "Return the wconfig in WORKGROUP's saved wconfigs named WCONFIG-OR-NAME.

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

    (etypecase wconfig-or-name

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

      (string (find wconfig-or-name wconfigs

                    :key 'wg-wconfig-name

                    :test 'string=)))))

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

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

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

;;; garbage collection

;; update buf list

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

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

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

  "Update all bufs in `wg-buf-list' corresponding to buffers in BUFFER-LIST."

  (mapc 'wg-update-buffer-in-buf-list (or buffer-list (buffer-list))))

;; gc buf uids

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

            (wg-remove-if-not 'wg-find-buf-by-uid it)

            (wg-workgroup-weak-buf-uids workgroup)

            (wg-remove-if-not 'wg-find-buf-by-uid it)))

(defun wg-gc-buf-uids ()

  "Remove from all workgroups those buf uids that have no referent in `wg-buf-list'."

  (mapc 'wg-workgroup-gc-buf-uids (wg-workgroup-list)))

;; gc bufs

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

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

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

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

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

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

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

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

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

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

  (reduce 'wg-string-list-union

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

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

(defun wg-session-all-buf-uids (&optional session)

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

SESSION nil defaults to `wg-current-session'."

  (reduce 'wg-string-list-union

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

          :key 'wg-workgroup-all-buf-uids))

(defun wg-buffer-list-all-uids (&optional buffer-list)

  "Return a list of the uids of all buffers in BUFFER-LIST in

which `wg-buffer-uid' is locally bound.

BUFFER-LIST nil defaults to `buffer-list'."

  (delq nil (mapcar 'wg-buffer-uid (or buffer-list (buffer-list)))))

(defun wg-all-buf-uids (&optional session buffer-list)

  "Return the union of `wg-session-all-buf-uids' and `wg-buffer-list-all-uids'."

  (union (wg-session-all-buf-uids session)

         (wg-buffer-list-all-uids buffer-list)

         :test 'string=))

(defun wg-gc-bufs ()

  "gc bufs from `wg-buf-list' that are no longer needed."

  (let ((all-buf-uids (wg-all-buf-uids)))

    (wg-asetf (wg-buf-list)

              (wg-remove-if-not (lambda (uid) (member uid all-buf-uids)) it

                             :key 'wg-buf-uid))))

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

  (wg-update-all-base-wconfigs)

  (wg-gc-bufs)

  (wg-gc-buf-uids)

  (wg-update-buf-list))

;; session consistency testing

(defun wg-session-uids-consistent-p ()

  "Return t if there are no duplicate bufs or buf uids in the wrong places,

nil otherwise."

  (and (every (lambda (wg)

                (not (wg-dups-p (wg-workgroup-associated-buf-uids wg)

                                :test 'string=)))

              (wg-workgroup-list))

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

;;; workgroup restoration

(defun wg-restore-workgroup-associated-buffers-internal (workgroup)

  "Restore all the buffers associated with WORKGROUP that can be restored."

  (save-window-excursion

    (delete nil (mapcar 'wg-restore-buffer

                        (wg-workgroup-associated-bufs workgroup)))))

(defun wg-restore-workgroup (workgroup)

  "Restore WORKGROUP in `selected-frame'."

  (when wg-restore-associated-buffers

    (wg-restore-workgroup-associated-buffers-internal workgroup))

  (let (wg-flag-modified)

    (wg-restore-wconfig-undoably

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

;;; workgroup-list ops

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

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

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

  (wg-awhen (wg-find-workgroup-by :name (wg-workgroup-name workgroup) t)

    (unless index (setq index (wg-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))))

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

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

          (when (or (not wg-confirm-on-get-workgroup-create)

                    (y-or-n-p (format "%S doesn't exist.  Create it? "

                                      workgroup)))

            (wg-make-and-add-workgroup workgroup))

        ;; Call this again for its error message

        (wg-get-workgroup workgroup))))

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

;;; buffer association

(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))'."

  (wg-aif (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-associate-frame-buffers ()

  "Associate the buffers visible in the current frame with the

current workgroup (unless it is currently being deactivated)."

  (wg-awhen (wg-current-workgroup :noerror)

    (unless (member it wg-deactivation-list)

      (wg-associate-buffers it (car (window-tree))))))

(defun wg-associate-all-frame-buffers ()

  "Associate all visible buffers with the current

workgroup (unless it is currently being deactivated)."

  (mapcar 'wg-associate-frame-buffers (frame-list)))

(defun wg-buffer-predicate (buffer)

  "Return t iff the given BUFFER should be considered a candidate

for display by `other-buffer' in the current workgroup."

  (or (not wg-associate-buffers)

      (wg-awhen (wg-current-workgroup :noerror)

        (with-current-buffer buffer

          (eq wg-buffer-workgroup it)))))

(defun wg-after-make-frame (frame)

  (set-frame-parameter frame 'buffer-predicate

                       'wg-buffer-predicate))

;;; mode-line

(defun wg-mode-line-buffer-association-indicator (workgroup)

  "Return a string indicating `current-buffer's association-type in WORKGROUP."

  (case (wg-workgroup-bufobj-association-type workgroup (current-buffer))

    (strong wg-mode-line-decor-strongly-associated)

    (weak wg-mode-line-decor-weakly-associated)

    (otherwise wg-mode-line-decor-unassociated)))

(defun wg-mode-line-string ()

  "Return the string to be displayed in the mode-line."

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

        (wg-use-faces wg-mode-line-use-faces))

    (cond (wg (wg-fontify " "

                ;;(consp (cons :div wg-mode-line-decor-left-brace))

                ;;(keywordp (car (cons :div wg-mode-line-decor-left-brace)))

                ;;(:div wg-mode-line-decor-left-brace)

                wg-mode-line-decor-left-brace

                (wg-workgroup-name wg)

                (if (not wg-mode-line-only-name)

                    (progn

                      wg-mode-line-decor-divider

                      (wg-mode-line-buffer-association-indicator wg)

                      wg-mode-line-decor-divider

                      (if (window-dedicated-p)

                                 wg-mode-line-decor-window-dedicated

                               wg-mode-line-decor-window-undedicated)

                      wg-mode-line-decor-divider

                      (if (wg-session-modified (wg-current-session))

                                 wg-mode-line-decor-session-modified

                               wg-mode-line-decor-session-unmodified)

                      (if (wg-workgroup-modified wg)

                          wg-mode-line-decor-workgroup-modified

                        wg-mode-line-decor-workgroup-unmodified)))

                wg-mode-line-decor-right-brace))

          (t (if wg-display-nowg

                 (progn

                   (wg-fontify " "

                     wg-mode-line-decor-left-brace

                     wg-nowg-string

                     wg-mode-line-decor-right-brace))

               "")))))

(defun wg-add-mode-line-display ()

  "Add Workgroups' mode-line format to `mode-line-format'."

  (unless (assq 'wg-mode-line-display-on mode-line-format)

    (let ((format '(wg-mode-line-display-on (:eval (wg-mode-line-string))))

          (pos (wg-position 'mode-line-position mode-line-format)))

      (set-default 'mode-line-format

                   (wg-insert-after format mode-line-format pos))

      (force-mode-line-update))))

(defun wg-remove-mode-line-display ()

  "Remove Workgroups' mode-line format from `mode-line-format'."

  (wg-awhen (assq 'wg-mode-line-display-on mode-line-format)

    (set-default 'mode-line-format (remove it mode-line-format))

    (force-mode-line-update)))

;;; messaging

(defun wg-message (format-string &rest args)

  "Call `message' with FORMAT-STRING and ARGS.

Also save the msg to `wg-last-message'."

  (setq wg-last-message (apply #'message format-string args)))

(defmacro wg-fontified-message (&rest format)

  "`wg-fontify' FORMAT and call `wg-message' on it."

  (declare (indent defun))

  `(wg-message (wg-fontify ,@format)))

;;; fancy displays

;; FIXME: add `wg-display-max-lines' to chop long display strings at max-line

;; and element-name boundaries

(defun wg-element-display (elt elt-string &optional current-elt-p previous-elt-p)

  "Return display string for ELT."

  (cond ((and current-elt-p (funcall current-elt-p elt))

         (wg-fontify (:cur (concat wg-list-display-decor-current-left

                                   elt-string

                                   wg-list-display-decor-current-right))))

        ((and previous-elt-p (funcall previous-elt-p elt))

         (wg-fontify (:prev (concat wg-list-display-decor-previous-left

                                    elt-string

                                    wg-list-display-decor-previous-right))))

        (t (wg-fontify (:other elt-string)))))

(defun wg-workgroup-display (workgroup index)

  "Return display string for WORKGROUP at INDEX."

  (if (not workgroup) wg-nowg-string

    (wg-element-display

     workgroup

     (format "%d: %s" index (wg-workgroup-name workgroup))

     'wg-current-workgroup-p

     'wg-previous-workgroup-p)))

(defun wg-buffer-display (buffer index)

  "Return display string for BUFFER. INDEX is ignored."

  (if (not buffer) "No buffers"

    (wg-element-display

     (wg-get-buffer buffer)

     (format "%s" (wg-buffer-name buffer))

     'wg-current-buffer-p)))

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

;;         (i -1))

;;     (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 (incf i))))

;;       (:brace wg-list-display-decor-right-brace))))

(defcustom wg-display-max-lines 1

  "FIXME: docstring this"

  :type 'integer

  :group 'workgroups)

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

            (:brace wg-list-display-decor-right-brace)))

    ;; (subseq str 0 wwidth)

    ))

(defun wg-workgroup-list-display (&optional workgroup-list)

  "Return the Workgroups 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))))

;; TODO: Possibly add scroll animation for the buffer list display during

;; `wg-next-buffer' and `wg-previous-buffer'

(defun wg-buffer-list-display (buffer-list)

  "Return the buffer-list display string."

  (wg-display-internal

   'wg-buffer-display

   (if wg-center-rotate-buffer-list-display

       (wg-center-rotate-list buffer-list) buffer-list)))

(defun wg-buffer-list-filter-display (&optional workgroup blf-id)

  "Return a buffer-list-filter display string from WORKGROUP and BLF-ID."

  (wg-fontify

    "("

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

    ":"

    (wg-get-buffer-list-filter-val blf-id 'indicator)

    ")"))

(defun wg-buffer-list-filter-prompt (prompt &optional workgroup blf-id)

  "Return a prompt string from PROMPT indicating WORKGROUP and BLF-ID."

  (wg-fontify

    prompt " "

    (wg-buffer-list-filter-display workgroup blf-id)

    ": "))

(defun wg-buffer-command-display (&optional buffer-list)

  "Return the buffer command display string."

  (concat

   (wg-buffer-list-filter-display) ": "

   (wg-buffer-list-display (or buffer-list (wg-filtered-buffer-list)))))

(defun wg-timeline-display (position length)

  "Return a timeline visualization string from POSITION and LENGTH."

  (wg-fontify

    ;;(cons :div "-<{")

    "-<{"

    (wg-make-string (- length position) "-" "=")