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

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

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

    (unless (member it wg-deactivation-list)

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

;; (switch-to-buffer)   -> (read-buffer-to-switch "Asd")

;; -> internal-complete-buffer-except -> internal-complete-buffer

;; minibuffer-complete  minibuffer-completion-table

;; ido-switch-buffer  -> buffer-list

;;(global-set-key "\C-d" delete-char)

;; fdefinition

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

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

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

              (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-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-read-buffer (prompt &optional default require-match)

  "Workgroups' version of `read-buffer'.

Read with PROMT DEFAULT REQUIRE-MATCH."

  (if (not (wg-filter-buffer-list-p))

      (funcall (wg-read-buffer-function) prompt default require-match)

    (wg-with-buffer-list-filters 'read-buffer

      (funcall (wg-read-buffer-function)

               (wg-buffer-list-filter-prompt

                    (substring prompt 0 it) prompt))

               default require-match))))

;;; filtered buffer-list construction

(defun wg-get-buffer-list-filter-id-flexibly (blf-id)

  "Return a buffer-list-filter-id one way or another."

  (or blf-id wg-current-buffer-list-filter-id 'all))

(defun wg-get-buffer-list-filter-val (id key &optional noerror)

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

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

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

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

)

;; ielm

(wg-support 'inferior-emacs-lisp-mode 'ielm

;;; workgroups-utils.el --- Utilities used by Workgroups

;;; Commentary:

;;

;; A bunch of general purpose-ish utilities used by Workgroups.

;;

;;; Code:

;;; utils used in macros

(require 'cl-lib)

(require 'workgroups-faces)

(require 'workgroups-variables)

(defmacro wg-with-gensyms (syms &rest body)

  "Bind all symbols in SYMS to `gensym's, and eval BODY."

  (declare (indent 1))

  `(let (,@(mapcar (lambda (sym) `(,sym (cl-gensym))) syms)) ,@body))

(defmacro wg-dbind (args expr &rest body)

  "Bind the variables in ARGS to the result of EXPR and execute BODY.

Abbreviation of `destructuring-bind'."

  (declare (indent 2))

  `(cl-destructuring-bind ,args ,expr ,@body))

(defun wg-partition (list &optional n step)

  "Take LIST, return a list of N length sublists, offset by STEP.

N defaults to 2, and STEP defaults to N.

Iterative to prevent stack overflow."

  (let* ((n (or n 2)) (step (or step n)) acc)

    (while list

      (push (wg-take list n) acc)

      (setq list (nthcdr step list)))

    (nreverse acc)))

\(fn (VAR LIST) BODY...)"

  (declare (indent 1))

  `(mapcar (lambda (,(car spec)) ,@body) ,(cadr spec)))

(defmacro wg-dohash (spec &rest body)

  "do-style wrapper for `maphash'.

\(fn (KEY VALUE TABLE [RESULT]) BODY...)"

  (declare (indent 1))

  (wg-dbind (key val table &optional result) spec

    `(progn (maphash (lambda (,key ,val) ,@body) ,table) ,result)))

(defmacro wg-doconcat (spec &rest body)

  "do-style wrapper for `mapconcat'.

\(fn (VAR SEQ [SEPARATOR]) BODY...)"

  (declare (indent 1))

  (wg-dbind (elt seq &optional sep) spec

    `(mapconcat (lambda (,elt) ,@body) ,seq (or ,sep ""))))

;;; anaphora

(defmacro wg-awhen (test &rest body)

  "Anaphoric `when'."

  (declare (indent 1))

(defmacro wg-asetf (&rest places-and-values)

  "Anaphoric `setf'."

  `(progn ,@(mapcar (lambda (pv) `(let ((it ,(car pv))) (setf ,@pv)))

                    (wg-partition places-and-values 2))))

;;; other control structures

(defmacro wg-destructuring-dolist (spec &rest body)

  "Loop over a list.

Evaluate BODY, destructuring LIST into SPEC, then evaluate RESULT

to get a return value, defaulting to nil.  The only hitch is that

spec must end in dotted style, collecting the rest of the list

into a var, like so: (a (b c) . rest)

\(fn (SPEC LIST [RESULT]) BODY...)"

  (declare (indent 1))

  (wg-dbind (loopspec list &optional result) spec

    (let ((rest (cdr (last loopspec))))

      (wg-with-gensyms (list-sym)

        `(let ((,list-sym ,list))

           (while ,list-sym

    (cl-loop for (elt . rest) on list

             for elt = (funcall key elt)

             when (cl-find elt rest :test test :key key) return elt)))

(defun wg-string-list-union (&optional list1 list2)

  "Return the `union' of LIST1 and LIST2, using `string=' as the test.

This only exists to get rid of duplicate lambdas in a few reductions."

  (cl-union list1 list2 :test 'string=))

;;; alists

(defun wg-make-alist (&rest kvps)

  "Return a new alist from KVPS."

  (let (alist)

    (while kvps

      (push (cons (car kvps) (cadr kvps)) alist)

      (setq kvps (cddr kvps)))

    (nreverse alist)))

(defun wg-aget (alist key &optional default)

  "Return the value of KEY in ALIST. Uses `assq'.

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

(defun wg-acopy (alist)

  "Return a copy of ALIST's toplevel list structure."

  (mapcar (lambda (kvp) (cons (car kvp) (cdr kvp))) alist))

(defun wg-aput (alist key value)

  "Return a new alist from ALIST with KEY's value set to VALUE."

  (let* ((found nil)

         (new (wg-docar (kvp alist)

                (if (not (eq key (car kvp))) kvp

                  (setq found (cons key value))))))

    (if found new (cons (cons key value) new))))

(defun wg-aremove (alist key)

  "`remove' KEY's key-value-pair from ALIST."

  (remove (assoc key alist) alist))

;;; symbols and strings

(defun wg-toggle (symbol)

  "Toggle SYMBOL's truthiness."

  (set symbol (not (symbol-value symbol))))

(require 'workgroups-wconfig)

(require 'workgroups-minibuffer)

;;

;; Variables

;;

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

(defcustom wg-confirm-on-get-workgroup-create nil

  "Non-nil means request confirmation before creating a new

workgroup when `wg-get-workgroup-create' is called with a string

that doesn't name an existing workgroup."

  :type 'boolean

  :group 'workgroups)

(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-current-workgroup (&optional noerror frame)

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

  (or wg-current-workgroup

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

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

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.

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

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

  (wg-awhen (wg-previous-workgroup t frame)

    (eq workgroup it)))

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

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

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

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

(provide 'workgroups-wtree)

;;; workgroups-wtree.el ends here